I intend to commit the following patch on Saturday.
It improves the reporting on where an error occurs.
Without the patch, one gets

% gfc7 -c gcc/testsuite/gfortran.dg/pr61318.f90 
gcc/testsuite/gfortran.dg/pr61318.f90:19:6:

   use gbl_message
      1
Error: Type mismatch in argument 'message' at (1); \
       passed INTEGER(4) to CHARACTER(1)


which points to the module where the function is declared.
With the patch, I get

% gfc7 -c gcc/testsuite/gfortran.dg/pr61318.f90
gcc/testsuite/gfortran.dg/pr61318.f90:21:78:

   call gagout(seve%e,'Some string')
                                   1
Error: Type mismatch in argument 'message' at (1); \
       passed INTEGER(4) to CHARACTER(1)

which points to the line where the error actually occurs.

2016-08-20  Steven G. Kargl  <ka...@gcc.gnu.org>

        PR fortran/61318
        * interface.c (compare_paramete): Use a better for error message.

2016-08-20  Steven G. Kargl  <ka...@gcc.gnu.org>
        PR fortran/61318
        * gfortran.dg/pr61318.f90: New test.


Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c     (revision 239543)
+++ gcc/fortran/interface.c     (working copy)
@@ -2146,7 +2146,7 @@ compare_parameter (gfc_symbol *formal, g
     {
       if (where)
        gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s",
-                  formal->name, &actual->where, gfc_typename (&actual->ts),
+                  formal->name, where, gfc_typename (&actual->ts),
                   gfc_typename (&formal->ts));
       return 0;
     }
Index: gcc/testsuite/gfortran.dg/pr61318.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr61318.f90       (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr61318.f90       (working copy)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+module gbl_message
+  type :: mytype
+    integer(kind=4) :: e
+  end type mytype
+  type(mytype), parameter :: seve = mytype(1)
+end module gbl_message
+
+module gbl_interfaces
+  interface
+    subroutine gagout(message)
+      character(len=*), intent(in) :: message
+    end subroutine gagout
+  end interface
+end module gbl_interfaces
+
+program test
+  use gbl_message
+  use gbl_interfaces
+  call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument" }
+end program test
+! { dg-final { cleanup-modules "gbl_interfaces gbl_message" } }
-- 
Steve

Reply via email to