]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Do not generate formal arglist from actual if we have already resolved it.
authorThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 11 May 2025 05:40:23 +0000 (07:40 +0200)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 11 May 2025 05:46:35 +0000 (07:46 +0200)
This bug was another case of generating a formal arglist from
an actual one where we should not have done so.  The fix is
straightforward:  If we have resolved the formal arglist, we should
not generare a new one.

OK for trunk and backport?

gcc/fortran/ChangeLog:

PR fortran/120163
* gfortran.h: Add formal_resolved to gfc_symbol.
* resolve.cc (gfc_resolve_formal_arglist): Set it.
(resolve_function): Do not call gfc_get_formal_from_actual_arglist
if we already resolved a formal arglist.
(resolve_call): Likewise.

gcc/testsuite/ChangeLog:

PR fortran/120163
* gfortran.dg/interface_61.f90: New test.

gcc/fortran/gfortran.h
gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/interface_61.f90 [new file with mode: 0644]

index 46310a088f26838f0ed3a9f402fa8ee4747d8bde..4740c3676d9819fcd3855ef9b315c5b388e03496 100644 (file)
@@ -2028,6 +2028,9 @@ typedef struct gfc_symbol
      This is legal in Fortran, but can cause problems with autogenerated
      C prototypes for C23.  */
   unsigned ext_dummy_arglist_mismatch:1;
+  /* Set if the formal arglist has already been resolved, to avoid
+     trying to generate it again from actual arguments.  */
+  unsigned formal_resolved:1;
 
   /* Reference counter, used for memory management.
 
index 1e62e94788b1435a04abf6bf5e38d71d75c8c9e6..bf1aa704888fcd55bba8e05e64c4cd1df743ba39 100644 (file)
@@ -533,7 +533,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
            }
        }
     }
-
+  if (sym)
+    sym->formal_resolved = 1;
   gfc_current_ns = orig_current_ns;
 }
 
@@ -3472,7 +3473,7 @@ resolve_function (gfc_expr *expr)
                           &expr->where, &sym->formal_at);
            }
        }
-      else
+      else if (!sym->formal_resolved)
        {
          gfc_get_formal_from_actual_arglist (sym, expr->value.function.actual);
          sym->formal_at = expr->where;
@@ -4033,7 +4034,7 @@ resolve_call (gfc_code *c)
                           &c->loc, &csym->formal_at);
            }
        }
-      else
+      else if (!csym->formal_resolved)
        {
          gfc_get_formal_from_actual_arglist (csym, c->ext.actual);
          csym->formal_at = c->loc;
diff --git a/gcc/testsuite/gfortran.dg/interface_61.f90 b/gcc/testsuite/gfortran.dg/interface_61.f90
new file mode 100644 (file)
index 0000000..15db3b8
--- /dev/null
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options -Wexternal-argument-mismatch }
+! PR fortran/120163 - this used to cause an error.
+! Original test case by Bálint Aradi
+module mod1
+  implicit none
+
+  abstract interface
+    pure subroutine callback_interface(a)
+      real, intent(in) :: a
+    end subroutine callback_interface
+  end interface
+
+contains
+
+  subroutine caller(callback)
+    procedure(callback_interface) :: callback
+    real :: a
+    call callback(a)
+  end subroutine caller
+
+end module mod1
+
+
+module mod2
+  use mod1
+end module mod2