[Bug fortran/40006] allow type cheating for procedures with an implicit interface

[kargl at gcc dot gnu dot org]

------- Comment #8 from kargl at gcc dot gnu dot org  2009-05-02 15:37 -------
For the code in Comment #1, I get

REMOVE:kargl[208] gfc4x -c -O -fwhole-file sa.f90
sa.f90:7.10:

  call S1(z)
          1
Warning: Type mismatch in argument 'z' at (1); passed COMPLEX(4) to REAL(4)
sa.f90:17.11:

   CALL S2(D(1,1),4)
           1
Warning: Element of assumed-shaped array passed to dummy argument 'd' at (1)

with this patch 

Index: interface.c
===================================================================
--- interface.c (revision 146793)
+++ interface.c (working copy)
@@ -1378,9 +1378,16 @@ compare_parameter (gfc_symbol *formal, g
       && !gfc_compare_types (&formal->ts, &actual->ts))
     {
       if (where)
-       gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
-                  formal->name, &actual->where, gfc_typename (&actual->ts),
-                  gfc_typename (&formal->ts));
+       {
+         if (gfc_option.flag_whole_file)
+           gfc_warning ("Type mismatch in argument '%s' at %L; passed %s to
%s",
+                        formal->name, &actual->where, gfc_typename
(&actual->ts),
+                        gfc_typename (&formal->ts));
+         else
+           gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
+                       formal->name, &actual->where, gfc_typename
(&actual->ts),
+                       gfc_typename (&formal->ts));
+       }
       return 0;
     }

@@ -1448,8 +1455,14 @@ compare_parameter (gfc_symbol *formal, g
          || actual->symtree->n.sym->attr.pointer))
     {
       if (where)
-       gfc_error ("Element of assumed-shaped array passed to dummy "
-                  "argument '%s' at %L", formal->name, &actual->where);
+       {
+         if (gfc_option.flag_whole_file)
+           gfc_warning ("Element of assumed-shaped array passed to dummy "
+                        "argument '%s' at %L", formal->name, &actual->where);
+         else
+           gfc_error ("Element of assumed-shaped array passed to dummy "
+                       "argument '%s' at %L", formal->name, &actual->where);
+       }
       return 0;
     }



-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40006