diff mbox series

Fortran - character type names in errors and warning - for review

Message ID ffb60571-24de-5270-1b35-91dad0e4429e@codethink.co.uk
State New
Headers show
Series Fortran - character type names in errors and warning - for review | expand

Commit Message

Mark Eggleston Sept. 9, 2019, 1:52 p.m. UTC 
Currently character type names are given as CHARACTER(1) or CHARACTER(4) 
for unicode.  I find this misleading as I would expect the length to be 
used instead of the kind.

I changed gfc_typename in misc.c to use the character length structure 
in the gfc_typespec structure. This works fine for character variables 
but not for character literals.  I then attempted to set the character 
length in the gfc_typespec structure, creating it if necessary, this 
apparently solved the problem, however, it had some unforeseen side affects:

The expected errors in:

      * gfortran.dg/char_length_7.f90
      * gfortran.dg/char_result_13.f90
      * gfortran.dg/entry_dummy_ref_3.f90
      * gfortran.dg/whole_file_23.f90

are different.

More seriously the following failed to execute correctly:

      * gfortran.dg/array_constructor_type_16.f03
      * gfortran.dg/structure_constructor_14.f90

To work around these problems I added a new length field to gfc_typespec 
to used to produce the name of a character type if the character length 
structure is not present.

The remaining problem was that of assumed length which can only occur 
for formal arguments, a new routine to handle the type names of dummy 
variables was added.  If the length structure is not present in the 
gfc_typespec for a formal argument of type CHARACTER then it has assumed 
length.

If the kind is the default character kind then the kind is omitted from 
the type name otherwise it is inserted after the length separated by a 
comma.

Reported name examples:

character(5) is reported as CHARACTER(5)
"" is reported as CHARACTER(0)
character(*) is reported as CHARACTER(*)
character(len=20, kind=4) is reported as CHARACTER(20,4)
4_"" is reported as CHARACTER(*,4)

The addition of the length field is a bit of kludge any pointers 
regarding a better solution will be appreciated.

The patch including test cases is attached.

ChangeLogs:

gcc/fortran

     Mark Eggleston <mark.eggleston@codethink.com>

     * arith.c (gfc_arith_concat): Set length field in typespec.
     * expr.c (gfc_get_character_expr): Set length field in typespec.
     * gfortran.h: Add length field to gfc_typespec for use to allow the
     length to available for character literals.
     * interface.c (gfc_check_dummy_characteristics): Use gfc_dummy_typename
     instead of gfc_typename when constructing error message to allow for
     CHARACTER(*) and CHARACTER(*,4).
     (compare_parameter): Use gfc_dummy_typename for formal argument when
     constructing error message to allow for CHARACTER(*) and
     CHARACTER(*,4).
     * intrinsic.c (gfc_actual_arglist): Reword error message so that
     CHARACTER(*) or CHARACTER(*,4) can be reported as the target type.  Use
     gfc_dummy_typename for the formal argument.
     * misc.c (gfc_typename): Add new local variable length and initialise
     with the value from the length field in typespec passed in.  If there
     is a character structure use the value from there for length.  If the
     kind is the default character kind construct the type name using length
     otherwise use the length followed by kind separated by a comma.
     (gfc_dummy_typename): New routine for use with formal arguments, if the
     typespec does not have a character length structure then the length is
     assumed and * is used for the length, if kind is not the default
     character kind follow * with a comma and then the kind.

gcc/testsuite

     Mark Eggleston <mark.eggleston@codethink.com>

     * gfortran.dg/bad_operands.f90: New test.
     * gfortran.dg/character mismatch.f90: New test.
     * gfortran.dg/compare_interfaces.f90: New test.
     * gfortran.dg/widechar_intrinsics_1.f90: Checked for specific character
     type names instead of "Type of argument".
     * gfortran.dg/widechar_intrinsics_2.f90: Checked for specific character
     type names instead of "Type of argument".
     * gfortran.dg/widechar_intrinsics_3.f90: Checked for specific character
     type names instead of "Type of argument".

Comments

Steve Kargl Sept. 12, 2019, 9 p.m. UTC | #1 
On Mon, Sep 09, 2019 at 02:52:20PM +0100, Mark Eggleston wrote:
> gcc/fortran
> 
>      Mark Eggleston <mark.eggleston@codethink.com>
> 
>      * arith.c (gfc_arith_concat): Set length field in typespec.
>      * expr.c (gfc_get_character_expr): Set length field in typespec.
>      * gfortran.h: Add length field to gfc_typespec for use to allow the
>      length to available for character literals.
>      * interface.c (gfc_check_dummy_characteristics): Use gfc_dummy_typename
>      instead of gfc_typename when constructing error message to allow for
>      CHARACTER(*) and CHARACTER(*,4).
>      (compare_parameter): Use gfc_dummy_typename for formal argument when
>      constructing error message to allow for CHARACTER(*) and
>      CHARACTER(*,4).
>      * intrinsic.c (gfc_actual_arglist): Reword error message so that
>      CHARACTER(*) or CHARACTER(*,4) can be reported as the target type.  Use
>      gfc_dummy_typename for the formal argument.
>      * misc.c (gfc_typename): Add new local variable length and initialise
>      with the value from the length field in typespec passed in.  If there
>      is a character structure use the value from there for length.  If the
>      kind is the default character kind construct the type name using length
>      otherwise use the length followed by kind separated by a comma.
>      (gfc_dummy_typename): New routine for use with formal arguments, if the
>      typespec does not have a character length structure then the length is
>      assumed and * is used for the length, if kind is not the default
>      character kind follow * with a comma and then the kind.
> 
> gcc/testsuite
> 
>      Mark Eggleston <mark.eggleston@codethink.com>
> 
>      * gfortran.dg/bad_operands.f90: New test.
>      * gfortran.dg/character mismatch.f90: New test.
>      * gfortran.dg/compare_interfaces.f90: New test.
>      * gfortran.dg/widechar_intrinsics_1.f90: Checked for specific character
>      type names instead of "Type of argument".
>      * gfortran.dg/widechar_intrinsics_2.f90: Checked for specific character
>      type names instead of "Type of argument".
>      * gfortran.dg/widechar_intrinsics_3.f90: Checked for specific character
>      type names instead of "Type of argument".
> 

This looks OK to me.  I don't know if anyone else will
glance at the patch.  You said that the patch has the
feeling of a kludge.  This is probably a by-product of
bolting kind=4 support onto what gfortran inherited long
ago.
Janne Blomqvist Sept. 13, 2019, 6:54 a.m. UTC | #2 
On Mon, Sep 9, 2019 at 4:52 PM Mark Eggleston
<mark.eggleston@codethink.co.uk> wrote:
> To work around these problems I added a new length field to gfc_typespec
> to used to produce the name of a character type if the character length
> structure is not present.

> The addition of the length field is a bit of kludge any pointers
> regarding a better solution will be appreciated.

Thanks for the patch, I agree that we should print character type
names better. However, I'm not really happy with this approach.
Requiring us to keep track of the character length in two places
sounds like a recipe for confusing bugs. I don't really have a good
solution thought out for this, but I think this should be solved
somehow before committing the patch.

Secondly, character lengths can be longer than what fits into int. In
gfortran.h you'll find

typedef HOST_WIDE_INT gfc_charlen_t;

and then you should use gfc_mpz_get_hwi() instead of mpz_get_si(). And
for the *printf() format string you should use
HOST_WIDE_INT_PRINT_DEC.

Thanks,
Mark Eggleston Sept. 13, 2019, 7:34 a.m. UTC | #3 
On 13/09/2019 07:54, Janne Blomqvist wrote:
> On Mon, Sep 9, 2019 at 4:52 PM Mark Eggleston
> <mark.eggleston@codethink.co.uk> wrote:
>> To work around these problems I added a new length field to gfc_typespec
>> to used to produce the name of a character type if the character length
>> structure is not present.
>> The addition of the length field is a bit of kludge any pointers
>> regarding a better solution will be appreciated.
> Thanks for the patch, I agree that we should print character type
> names better. However, I'm not really happy with this approach.
> Requiring us to keep track of the character length in two places
> sounds like a recipe for confusing bugs. I don't really have a good
> solution thought out for this, but I think this should be solved
> somehow before committing the patch.
I agree, it was an east fix to get it to work.  The issues with existing 
location for character length should investigated further and a better 
solution found.
>
> Secondly, character lengths can be longer than what fits into int. In
> gfortran.h you'll find
>
> typedef HOST_WIDE_INT gfc_charlen_t;
>
> and then you should use gfc_mpz_get_hwi() instead of mpz_get_si(). And
> for the *printf() format string you should use
> HOST_WIDE_INT_PRINT_DEC.
Acknowledged.
>
> Thanks,

Will submit an updated patch when fixed.

regards,

Mark
diff mbox series

Patch

From d8d42618b4dc2f653887b7723b17d1f6bf4e8f63 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Fri, 30 Aug 2019 11:08:26 +0100
Subject: [PATCH] Character typenames in errors and warnings

Character type names now incorporate length, kind is only shown if
the default character is not being used.

Examples:

  character(7) is reported as CHARACTER(7)
  character(len=20,kind=4) is reported as CHARACTER(20,4)

dummy character variables with assumed length:

  character(*) is reported as CHARACTER(*)
  character(*,kind=4) is reported as CHARACTER(*,4)
---
 gcc/fortran/arith.c                                |  1 +
 gcc/fortran/expr.c                                 |  1 +
 gcc/fortran/gfortran.h                             |  2 +
 gcc/fortran/interface.c                            | 10 +--
 gcc/fortran/intrinsic.c                            | 11 ++--
 gcc/fortran/misc.c                                 | 41 +++++++++++-
 gcc/testsuite/gfortran.dg/bad_operands.f90         | 10 +++
 gcc/testsuite/gfortran.dg/character_mismatch.f90   | 76 ++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/compare_interfaces.f90   | 73 +++++++++++++++++++++
 .../gfortran.dg/widechar_intrinsics_1.f90          | 12 ++--
 .../gfortran.dg/widechar_intrinsics_2.f90          | 10 +--
 .../gfortran.dg/widechar_intrinsics_3.f90          |  4 +-
 12 files changed, 228 insertions(+), 23 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/bad_operands.f90
 create mode 100644 gcc/testsuite/gfortran.dg/character_mismatch.f90
 create mode 100644 gcc/testsuite/gfortran.dg/compare_interfaces.f90

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index ff279db4992..82ab5bad396 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1005,6 +1005,7 @@  gfc_arith_concat (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 
   result->value.character.string = gfc_get_wide_string (len + 1);
   result->value.character.length = len;
+  result->ts.length = len;
 
   memcpy (result->value.character.string, op1->value.character.string,
 	  op1->value.character.length * sizeof (gfc_char_t));
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index c6d17d6f27f..44278ef73e4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -203,6 +203,7 @@  gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t l
                             where ? where : &gfc_current_locus);
   e->value.character.string = dest;
   e->value.character.length = len;
+  e->ts.length = len;
 
   return e;
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 80e31ee1a87..eb562373b2b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1032,6 +1032,7 @@  typedef struct
 {
   bt type;
   int kind;
+  int length; /* For type name reporting.  */
 
   union
   {
@@ -2880,6 +2881,7 @@  void gfc_end_source_files (void);
 void gfc_clear_ts (gfc_typespec *);
 FILE *gfc_open_file (const char *);
 const char *gfc_basic_typename (bt);
+const char *gfc_dummy_typename (gfc_typespec *);
 const char *gfc_typename (gfc_typespec *);
 const char *gfc_op2string (gfc_intrinsic_op);
 const char *gfc_code2string (const mstring *, int);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 43d7cd5a296..d02931fdc50 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1330,7 +1330,8 @@  gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
 	  || !compare_type_characteristics (s2, s1))
 	{
 	  snprintf (errmsg, err_len, "Type mismatch in argument '%s' (%s/%s)",
-		    s1->name, gfc_typename (&s1->ts), gfc_typename (&s2->ts));
+		    s1->name, gfc_dummy_typename (&s1->ts),
+		    gfc_dummy_typename (&s2->ts));
 	  return false;
 	}
       if (!compare_rank (s1, s2))
@@ -2313,9 +2314,10 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     {
       if (where)
 	gfc_error_opt (OPT_Wargument_mismatch,
-		       "Type mismatch in argument %qs at %L; passed %s to %s",
-		       formal->name, where, gfc_typename (&actual->ts),
-		       gfc_typename (&formal->ts));
+		       "Type mismatch in argument %qs at %L; passed %s "
+		       "to %s", formal->name, where,
+		       gfc_typename (&actual->ts),
+		       gfc_dummy_typename (&formal->ts));
       return false;
     }
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 764e3500926..f4ebc1ab047 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4363,11 +4363,12 @@  check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
       if (!gfc_compare_types (&ts, &actual->expr->ts))
 	{
 	  if (error_flag)
-	    gfc_error ("Type of argument %qs in call to %qs at %L should "
-		       "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
-		       gfc_current_intrinsic, &actual->expr->where,
-		       gfc_typename (&formal->ts),
-		       gfc_typename (&actual->expr->ts));
+	    gfc_error ("In call to %qs at %L, type mismatch in argument "
+		       "%qs; pass %qs to %qs", gfc_current_intrinsic,
+		       &actual->expr->where,
+		       gfc_current_intrinsic_arg[i]->name,
+		       gfc_typename (&actual->expr->ts),
+		       gfc_dummy_typename (&formal->ts));
 	  return false;
 	}
 
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index eed203dee02..b21dc2574ab 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -129,6 +129,7 @@  gfc_typename (gfc_typespec *ts)
   static int flag = 0;
   char *buffer;
   gfc_typespec *ts1;
+  int length = ts->length;
 
   buffer = flag ? buffer1 : buffer2;
   flag = !flag;
@@ -148,7 +149,12 @@  gfc_typename (gfc_typespec *ts)
       sprintf (buffer, "LOGICAL(%d)", ts->kind);
       break;
     case BT_CHARACTER:
-      sprintf (buffer, "CHARACTER(%d)", ts->kind);
+      if (ts->u.cl && ts->u.cl->length)
+	length = mpz_get_si (ts->u.cl->length->value.integer);
+      if (ts->kind == gfc_default_character_kind)
+	sprintf (buffer, "CHARACTER(%d)", length);
+      else
+	sprintf (buffer, "CHARACTER(%d,%d)", length, ts->kind);
       break;
     case BT_HOLLERITH:
       sprintf (buffer, "HOLLERITH");
@@ -186,6 +192,39 @@  gfc_typename (gfc_typespec *ts)
 }
 
 
+/* The type of a dummy variable can also be CHARACTER(*).  */
+
+const char *
+gfc_dummy_typename (gfc_typespec *ts)
+{
+  static char buffer1[15];  /* 15 for "CHARACTER(*,4)" + '\0'.  */
+  static char buffer2[15];
+  static int flag = 0;
+  char *buffer;
+
+  buffer = flag ? buffer1 : buffer2;
+  flag = !flag;
+
+  if (ts->type == BT_CHARACTER)
+    {
+      bool has_length = false;
+      if (ts->u.cl)
+	has_length = ts->u.cl->length != NULL;
+      if (!has_length)
+	{
+	  if (ts->kind == gfc_default_character_kind)
+	    sprintf(buffer, "CHARACTER(*)");
+	  else if (ts->kind < 10)
+	    sprintf(buffer, "CHARACTER(*,%d)", ts->kind);
+	  else
+	    sprintf(buffer, "CHARACTER(*,?)");
+	  return buffer;
+	}
+    }
+  return gfc_typename(ts);
+}
+
+
 /* Given an mstring array and a code, locate the code in the table,
    returning a pointer to the string.  */
 
diff --git a/gcc/testsuite/gfortran.dg/bad_operands.f90 b/gcc/testsuite/gfortran.dg/bad_operands.f90
new file mode 100644
index 00000000000..e82a07fdbd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bad_operands.f90
@@ -0,0 +1,10 @@ 
+! { dg-do compile }
+!
+! Test case contributed by Mark Eggleston  <mark.eggleston@codethink.com>
+
+program test
+  integer(4) :: x
+  
+  x = x // "rubbish"       ! { dg-error "INTEGER\\(4\\)/CHARACTER\\(7\\)" }
+  x = 4_"more rubbish" + 6 ! { dg-error "CHARACTER\\(12,4\\)/INTEGER\\(4\\)" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/character_mismatch.f90 b/gcc/testsuite/gfortran.dg/character_mismatch.f90
new file mode 100644
index 00000000000..e1619467ccc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_mismatch.f90
@@ -0,0 +1,76 @@ 
+! { dg-do compile }
+!
+! Test case contributed by Mark Eggleston  <mark.eggleston@codethink.com>
+
+program test
+  use iso_fortran_env
+  implicit none
+  integer, parameter :: ucs4 = selected_char_kind('ISO_10646')
+  integer :: x
+  character(len=7) :: s = "abcd123"
+  character(4, ucs4) :: s4 = char(int(z'20ac'), ucs4) // ucs4_"100"
+
+  x = s
+  x = "string"
+  x = "A longer string" // " plus a bit"
+  x = s // s
+  x = s // "a bit more"
+  x = "prefix:" // s
+  x = s4
+  x = ucs4_"string"
+  x = ucs4_"A longer string" // ucs4_" plus a bit"
+  x = s4 // s4
+  x = s4 // ucs4_"a bit more"
+  x = ucs4_"prefix:" // s4
+
+  call f(s)
+  call f("string")
+  call f("A longer string" // " plus a bit")
+  call f(s // s)
+  call f(s // "a bit more")
+  call f("a string:" // s)
+
+  call f(s4)
+  call f(ucs4_"string")
+  call f(ucs4_"A longer string" // ucs4_" plus a bit")
+  call f(s4 // s4)
+  call f(s4 // ucs4_"a bit more")
+  call f(ucs4_"a string:" // s4)
+
+  write(*,*) "" // ucs4_""
+
+contains
+  subroutine f(y)
+    integer, intent(in) :: y
+
+    write(*,*) y
+  end subroutine f
+
+end program
+
+! { dg-error "CHARACTER\\(7\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 13 }
+! { dg-error "CHARACTER\\(6\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 14 }
+! { dg-error "CHARACTER\\(26\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 15 }
+! { dg-error "CHARACTER\\(14\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 16 }
+! { dg-error "CHARACTER\\(17\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 17 }
+! { dg-error "CHARACTER\\(14\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 18 }
+! { dg-error "CHARACTER\\(4,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 19 }
+! { dg-error "CHARACTER\\(6,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 20 }
+! { dg-error "CHARACTER\\(26,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 21 }
+! { dg-error "CHARACTER\\(8,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 22 }
+! { dg-error "CHARACTER\\(14,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 23 }
+! { dg-error "CHARACTER\\(11,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 24 }
+! { dg-error "CHARACTER\\(7\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 26 }
+! { dg-error "CHARACTER\\(6\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 27 }
+! { dg-error "CHARACTER\\(26\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 28 }
+! { dg-error "CHARACTER\\(14\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 29 }
+! { dg-error "CHARACTER\\(17\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 30 }
+! { dg-error "CHARACTER\\(16\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 31 }
+! { dg-error "CHARACTER\\(4,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 33 }
+! { dg-error "CHARACTER\\(6,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 34 }
+! { dg-error "CHARACTER\\(26,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 35 }
+! { dg-error "CHARACTER\\(8,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 36 }
+! { dg-error "CHARACTER\\(14,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 37 }
+! { dg-error "CHARACTER\\(13,4\\) to INTEGER\\(4\\)" "type mismatch" { target \*-\*-\* } 38 }
+! { dg-error "CHARACTER\\(0\\)/CHARACTER\\(0,4\\)" "operand type mismatch" { target \*-\*-\* } 40 }
+
diff --git a/gcc/testsuite/gfortran.dg/compare_interfaces.f90 b/gcc/testsuite/gfortran.dg/compare_interfaces.f90
new file mode 100644
index 00000000000..cb2cbb759a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/compare_interfaces.f90
@@ -0,0 +1,73 @@ 
+! { dg-do compile }
+!
+! Contributed by Mark Eggleston  <mark.eggleston@codethink.co.uk>
+
+subroutine f(a, b)
+  integer :: a
+  real :: b
+
+  write(*,*) a, b
+end subroutine
+
+subroutine g(a, b)
+  integer :: a
+  character(*) :: b
+
+  write(*,*) a, b
+end subroutine
+
+subroutine h
+  interface
+    subroutine f(a, b)  ! { dg-error "\\(CHARACTER\\(\\*\\)/REAL\\(4\\)\\)" }
+      integer :: a
+      character(*) :: b
+    end subroutine
+    subroutine g(a, b)  ! { dg-error "\\(REAL\\(4\\)/CHARACTER\\(\\*\\)\\)" }
+      integer :: a
+      real :: b
+    end subroutine
+  end interface
+
+  call f(6, 6.0)
+  call g(6, "abcdef")
+end subroutine
+
+subroutine f4(a, b)
+  integer :: a
+  real :: b
+
+  write(*,*) a, b
+end subroutine
+
+subroutine g4(a, b)
+  integer :: a
+  character(*,4) :: b
+
+  write(*,*) a, b
+end subroutine
+
+subroutine h4
+  interface
+    subroutine f4(a, b)  ! { dg-error "\\(CHARACTER\\(\\*,4\\)/REAL\\(4\\)\\)" }
+      integer :: a
+      character(*,4) :: b
+    end subroutine
+    subroutine g4(a, b)  ! { dg-error "REAL\\(4\\)/CHARACTER\\(\\*,4\\)" }
+      integer :: a
+      real :: b
+    end subroutine
+  end interface
+
+  call f4(6, 6.0) 
+  call g4(6, 4_"abcdef")
+end subroutine
+
+program test
+  call h
+  call h4
+end program
+
+! { dg-error "passed REAL\\(4\\) to CHARACTER\\(\\*\\)" "type mismatch" { target \*-\*-\* } 31 }
+! { dg-error "passed CHARACTER\\(6\\) to REAL\\(4\\)" "type mismatch" { target \*-\*-\* } 32 }
+! { dg-error "passed REAL\\(4\\) to CHARACTER\\(\\*,4\\)" "type mismatch" { target \*-\*-\* } 61 }
+! { dg-error "passed CHARACTER\\(6,4\\) to REAL\\(4\\)" "type mismatch" { target \*-\*-\* } 62 }
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90
index cb9804296dd..259ed1b783e 100644
--- a/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90
@@ -15,18 +15,18 @@ 
   call date_and_time(s4, t4, u4) ! { dg-error "must be of kind 1" }
 
   call get_command(s1)
-  call get_command(s4) ! { dg-error "Type of argument" }
+  call get_command(s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   call get_command_argument(1, s1)
-  call get_command_argument(1, s4) ! { dg-error "Type of argument" }
+  call get_command_argument(1, s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   call get_environment_variable("PATH", s1)
   call get_environment_variable(s1)
   call get_environment_variable(s1, t1)
-  call get_environment_variable(4_"PATH", s1) ! { dg-error "Type of argument" }
-  call get_environment_variable(s4) ! { dg-error "Type of argument" }
-  call get_environment_variable(s1, t4) ! { dg-error "Type of argument" }
-  call get_environment_variable(s4, t1) ! { dg-error "Type of argument" }
+  call get_environment_variable(4_"PATH", s1) ! { dg-error "'CHARACTER\\(4,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call get_environment_variable(s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call get_environment_variable(s1, t4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call get_environment_variable(s4, t1) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   print *, lge(s1,t1)
   print *, lge(s1,"foo")
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90
index 0a1d449b605..db4fc3c1f4e 100644
--- a/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90
@@ -38,9 +38,9 @@  program failme
   call getcwd (s4, i) ! { dg-error "must be of kind" }
 
   call getenv (s1, t1)
-  call getenv (s1, t4) ! { dg-error "Type of argument" }
-  call getenv (s4, t1) ! { dg-error "Type of argument" }
-  call getenv (s4, t4) ! { dg-error "Type of argument" }
+  call getenv (s1, t4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call getenv (s4, t1) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call getenv (s4, t4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   call getarg (i, s1)
   call getarg (i, s4) ! { dg-error "must be of kind" }
@@ -115,8 +115,8 @@  program failme
 
   call system (s1)
   call system (s1, i)
-  call system (s4) ! { dg-error "Type of argument" }
-  call system (s4, i) ! { dg-error "Type of argument" }
+  call system (s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
+  call system (s4, i) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   call ttynam (i, s1)
   call ttynam (i, s4) ! { dg-error "must be of kind" }
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90
index 7073b893bb3..7995c3693f9 100644
--- a/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90
@@ -35,7 +35,7 @@  program failme
   print *, fputc (i, s4) ! { dg-error "must be of kind" }
 
   print *, getcwd (s1)
-  print *, getcwd (s4) ! { dg-error "Type of argument" }
+  print *, getcwd (s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   print *, hostnm (s1)
   print *, hostnm (s4) ! { dg-error "must be of kind" }
@@ -61,7 +61,7 @@  program failme
   print *, symlnk (s4, t4) ! { dg-error "must be of kind" }
 
   print *, system (s1)
-  print *, system (s4) ! { dg-error "Type of argument" }
+  print *, system (s4) ! { dg-error "'CHARACTER\\(20,4\\)' to 'CHARACTER\\(\\*\\)'" }
 
   print *, unlink (s1)
   print *, unlink (s4) ! { dg-error "must be of kind" }
-- 
2.11.0