Hello world,

I have just committed the attached patch to master as obvious and
simple. Explanation is in the ChangeLog below.

Best regards

        Thomas

Fix ICE on warning with new interface check (the patch for PR 27318).

In the test case, there was a warning about INTENT where an EXTERNAL
masked an interface in an outer scope, when the location of the
symbol was not set, leading to an ICE.

Two problems, two-part solution: It makes no sense to warn about
INTENT for artificially generated formal argument lists, and the
location should be set.

gcc/fortran/ChangeLog:

        PR fortran/96073
        * frontend-passes.c (check_externals_procedure):  Add locus
        information for new_sym.
        * interface.c (gfc_check_dummy_characteristics): Do not warn
        about INTENT for artificially generated variables.

gcc/testsuite/ChangeLog:

        PR fortran/96073
        * gfortran.dg/interface_48.f90: New test
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 69f9ca64c97..7768fdc25ca 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5441,6 +5441,7 @@ check_externals_procedure (gfc_symbol *sym, locus *loc,
   gfc_current_ns = gsym->ns;
 
   gfc_get_formal_from_actual_arglist (new_sym, actual);
+  new_sym->declared_at = *loc;
   gfc_current_ns = save_ns;
 
   return 0;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 0cc504f4e04..e51820918b8 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1343,7 +1343,8 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
     }
 
   /* Check INTENT.  */
-  if (s1->attr.intent != s2->attr.intent)
+  if (s1->attr.intent != s2->attr.intent && !s1->attr.artificial
+      && !s2->attr.artificial)
     {
       snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'",
 		s1->name);
diff --git a/gcc/testsuite/gfortran.dg/interface_48.f90 b/gcc/testsuite/gfortran.dg/interface_48.f90
new file mode 100644
index 00000000000..f7513324172
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_48.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR 96073 - this used to cause an ICE.
+! Test case by Jürgen Reuter.
+
+module m
+  implicit none
+  private
+
+  interface
+     subroutine GetXminM (set, xmin)
+       integer, intent(in) :: set
+       real, intent(out) :: xmin
+     end subroutine GetXminM
+  end interface
+  interface 
+     subroutine foo(a)  ! { dg-warning "Type mismatch" }
+       integer, intent(in) :: a 
+     end subroutine foo
+  end interface
+
+contains
+
+  subroutine s ()
+    real :: xmin
+    integer :: set
+    external :: GetXminM, foo
+    call GetXminM (set, xmin)
+    call foo(1.0) ! { dg-warning "Type mismatch" }
+  end subroutine s
+
+end module m

Reply via email to