C prototypes for external arguments; add warning for mismatch.

The problem was that we were not handling external dummy arguments
with -fc-prototypes-external. In looking at this, I found that we
were not warning about external procedures with different argument
lists.  This can actually be legal (see the two test cases) but
creates a problem for the C prototypes: If we have something like

subroutine foo(a,n)
  external a
  if (n == 1) call a(1)
  if (n == 2) call a(2,3)
end subroutine foo

then, pre-C23, we could just have written out the prototype as

void foo_ (void (*a) (), int *n);

but this is illegal in C23. What to do?  I finally chose to warn
about the argument mismatch, with a new option. Warn only because the
code above is legal, but include in -Wall because such code seems highly
suspect.  This option is also implied in -fc-prototypes-external. I also
put a warning in the generated header file in that case, so users
have a chance to see what is going on (especially since gcc now
defaults to C23).

gcc/fortran/ChangeLog:

	PR fortran/119049
	PR fortran/119074
	* dump-parse-tree.cc (seen_conflict): New static varaible.
	(gfc_dump_external_c_prototypes): Initialize it. If it was
	set, write out a warning that -std=c23 will not work.
	(write_proc): Move the work of actually writing out the
	formal arglist to...
	(write_formal_arglist): New function. Handle external dummy
	parameters and their argument lists. If there were mismatched
	arguments, output an empty argument list in pre-C23 style.
	* gfortran.h (struct gfc_symbol): Add ext_dummy_arglist_mismatch
	flag and formal_at.
	* invoke.texi: Document -Wexternal-argument-mismatch.
	* lang.opt: Put it in.
	* resolve.cc (resolve_function): If warning about external
	argument mismatches, build a formal from actual arglist the
	first time around, and later compare and warn.
	(resolve_call): Likewise

gcc/testsuite/ChangeLog:

	PR fortran/119049
	PR fortran/119074
	* gfortran.dg/interface_55.f90: New test.
	* gfortran.dg/interface_56.f90: New test.

7 files changed, 220 insertions, 37 deletions

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 7726b70..1a15757 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -4108,6 +4108,8 @@ gfc_dump_c_prototypes (FILE *file)
 
 /* Loop over all external symbols, writing out their declarations.  */
 
+static bool seen_conflict;
+
 void
 gfc_dump_external_c_prototypes (FILE * file)
 {
@@ -4119,6 +4121,7 @@ gfc_dump_external_c_prototypes (FILE * file)
     return;
 
   dumpfile = file;
+  seen_conflict = false;
   fprintf (dumpfile,
 	   _("/* Prototypes for external procedures generated from %s\n"
 	     "   by GNU Fortran %s%s.\n\n"
@@ -4130,6 +4133,11 @@ gfc_dump_external_c_prototypes (FILE * file)
     return;
 
   gfc_traverse_gsymbol (gfc_gsym_root, show_external_symbol, (void *) &bind_c);
+  if (seen_conflict)
+    fprintf (dumpfile,
+	     _("\n\n/* WARNING: Because of differing arguments to an external\n"
+	       "   procedure, this header file is not compatible with -std=c23."
+	       "\n\n   Use another -std option to compile.  */\n"));
 }
 
 /* Callback function for dumping external symbols, be they BIND(C) or
@@ -4406,52 +4414,35 @@ write_variable (gfc_symbol *sym)
   fputs (";\n", dumpfile);
 }
 
-
-/* Write out a procedure, including its arguments.  */
 static void
-write_proc (gfc_symbol *sym, bool bind_c)
+write_formal_arglist (gfc_symbol *sym, bool bind_c)
 {
-  const char *pre, *type_name, *post;
-  bool asterisk;
-  enum type_return rok;
   gfc_formal_arglist *f;
-  const char *sym_name;
-  const char *intent_in;
-  bool external_character;
-
-  external_character =  sym->ts.type == BT_CHARACTER && !bind_c;
-
-  if (sym->binding_label)
-    sym_name = sym->binding_label;
-  else
-    sym_name = sym->name;
-
-  if (sym->ts.type == BT_UNKNOWN || external_character)
-    {
-      fprintf (dumpfile, "void ");
-      fputs (sym_name, dumpfile);
-    }
-  else
-    write_decl (&(sym->ts), sym->as, sym_name, true, &sym->declared_at, bind_c);
-
-  if (!bind_c)
-    fputs ("_", dumpfile);
 
-  fputs (" (", dumpfile);
-  if (external_character)
-    {
-      fprintf (dumpfile, "char *result_%s, size_t result_%s_len",
-	       sym_name, sym_name);
-      if (sym->formal)
-	fputs (", ", dumpfile);
-    }
-
-  for (f = sym->formal; f; f = f->next)
+  for (f = sym->formal; f != NULL; f = f->next)
     {
+      enum type_return rok;
+      const char *intent_in;
       gfc_symbol *s;
+      const char *pre, *type_name, *post;
+      bool asterisk;
+
       s = f->sym;
       rok = get_c_type_name (&(s->ts), s->as, &pre, &type_name, &asterisk,
 			     &post, false);
+      /* Procedure arguments have to be converted to function pointers.  */
+      if (s->attr.subroutine)
+	{
+	  fprintf (dumpfile, "void (*%s) (", s->name);
+	  if (s->ext_dummy_arglist_mismatch)
+	    seen_conflict = true;
+	  else
+	    write_formal_arglist (s, bind_c);
+
+	  fputc (')', dumpfile);
+	  goto next;
+	}
+
       if (rok == T_ERROR)
 	{
 	  gfc_error_now ("Cannot convert %qs to interoperable type at %L",
@@ -4461,6 +4452,18 @@ write_proc (gfc_symbol *sym, bool bind_c)
 	  return;
 	}
 
+      if (s->attr.function)
+	{
+	  fprintf (dumpfile, "%s (*%s) (", type_name, s->name);
+	  if (s->ext_dummy_arglist_mismatch)
+	    seen_conflict = true;
+	  else
+	    write_formal_arglist (s, bind_c);
+
+	  fputc (')',dumpfile);
+	  goto next;
+	}
+
       /* For explicit arrays, we already set the asterisk above.  */
       if (!s->attr.value && !(s->as && s->as->type == AS_EXPLICIT))
 	asterisk = true;
@@ -4481,6 +4484,7 @@ write_proc (gfc_symbol *sym, bool bind_c)
       if (bind_c && rok == T_WARN)
 	fputs(" /* WARNING: non-interoperable KIND */ ", dumpfile);
 
+    next:
       if (f->next)
 	fputs(", ", dumpfile);
     }
@@ -4489,6 +4493,42 @@ write_proc (gfc_symbol *sym, bool bind_c)
       if (f->sym->ts.type == BT_CHARACTER)
 	fprintf (dumpfile, ", size_t %s_len", f->sym->name);
 
+}
+
+/* Write out a procedure, including its arguments.  */
+static void
+write_proc (gfc_symbol *sym, bool bind_c)
+{
+  const char *sym_name;
+  bool external_character;
+
+  external_character =  sym->ts.type == BT_CHARACTER && !bind_c;
+
+  if (sym->binding_label)
+    sym_name = sym->binding_label;
+  else
+    sym_name = sym->name;
+
+  if (sym->ts.type == BT_UNKNOWN || external_character)
+    {
+      fprintf (dumpfile, "void ");
+      fputs (sym_name, dumpfile);
+    }
+  else
+    write_decl (&(sym->ts), sym->as, sym_name, true, &sym->declared_at, bind_c);
+
+  if (!bind_c)
+    fputs ("_", dumpfile);
+
+  fputs (" (", dumpfile);
+  if (external_character)
+    {
+      fprintf (dumpfile, "char *result_%s, size_t result_%s_len",
+	       sym_name, sym_name);
+      if (sym->formal)
+	fputs (", ", dumpfile);
+    }
+  write_formal_arglist (sym, bind_c);
   fputs (");\n", dumpfile);
 }
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 425454b..927f22c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2023,6 +2023,10 @@ typedef struct gfc_symbol
      scope. Used in the suppression of uninitialized warnings in reallocation
      on assignment.  */
   unsigned allocated_in_scope:1;
+  /* Set if an external dummy argument is called with different argument lists.
+     This is legal in Fortran, but can cause problems with autogenerated
+     C prototypes for C23.  */
+  unsigned ext_dummy_arglist_mismatch;
 
   /* Reference counter, used for memory management.
 
@@ -2068,6 +2072,10 @@ typedef struct gfc_symbol
 
   /* Link to next entry in derived type list */
   struct gfc_symbol *dt_next;
+
+  /* This is for determining where the symbol has been used first, for better
+     location of error messages.  */
+  locus formal_at;
 }
 gfc_symbol;
 
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 0b50508..da085d1 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -242,6 +242,7 @@ is ignored and no user-defined procedure with the same name as any
 intrinsic is called except when it is explicitly declared @code{EXTERNAL}.
 
 @opindex fallow-argument-mismatch
+@cindex argument mismatch
 @item -fallow-argument-mismatch
 Some code contains calls to external procedures with mismatches
 between the calls and the procedure definition, or with mismatches
@@ -1068,6 +1069,15 @@ the expression after conversion. Implied by @option{-Wall}.
 Warn about implicit conversions between different types and kinds. This
 option does @emph{not} imply @option{-Wconversion}.
 
+@opindex Wexternal-argument-mismatch
+@cindex warnings, argument mismatch
+@cindex argment mismatch, warnings
+@item -Wexternal-argument-mismatch
+Warn about argument mismatches for dummy external procedures.  This is
+implied by @option{-fc-prototypes-external} because generation of a
+valid C23 interface is not possible in such a case.  Also implied
+by @option{-Wall}.
+
 @opindex Wextra
 @cindex extra warnings
 @cindex warnings, extra
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 1824c1d9..7826a1a 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -241,6 +241,10 @@ Wdo-subscript
 Fortran Var(warn_do_subscript) Warning LangEnabledBy(Fortran,Wextra)
 Warn about possibly incorrect subscripts in do loops.
 
+Wexternal-argument-mismatch
+Fortran Var(warn_external_argument_mismatch) Warning LangEnabledBy(Fortran,Wall || fc-prototypes-external)
+Warn when arguments of external procedures do not match.
+
 Wextra
 Fortran Warning
 ; Documented in common
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f83d122a..0773d05 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -3427,6 +3427,32 @@ resolve_function (gfc_expr *expr)
       return false;
     }
 
+  /* Add and check formal interface when -fc-prototypes-external is in
+     force, see comment in resolve_call().  */
+
+  if (warn_external_argument_mismatch && sym && sym->attr.dummy
+      && sym->attr.external)
+    {
+      if (sym->formal)
+	{
+	  bool conflict;
+	  conflict = !gfc_compare_actual_formal (&expr->value.function.actual,
+						 sym->formal, 0, 0, 0, NULL);
+	  if (conflict)
+	    {
+	      sym->ext_dummy_arglist_mismatch = 1;
+	      gfc_warning (OPT_Wexternal_argument_mismatch,
+			   "Different argument lists in external dummy "
+			   "function %s at %L and %L", sym->name,
+			   &expr->where, &sym->formal_at);
+	    }
+	}
+      else
+	{
+	  gfc_get_formal_from_actual_arglist (sym, expr->value.function.actual);
+	  sym->formal_at = expr->where;
+	}
+    }
   /* See if function is already resolved.  */
 
   if (expr->value.function.name != NULL
@@ -3939,6 +3965,43 @@ resolve_call (gfc_code *c)
   if (csym && is_external_proc (csym))
     resolve_global_procedure (csym, &c->loc, 1);
 
+  /* If we have an external dummy argument, we want to write out its arguments
+     with -fc-prototypes-external.  Code like
+
+     subroutine foo(a,n)
+       external a
+       if (n == 1) call a(1)
+       if (n == 2) call a(2,3)
+     end subroutine foo
+
+     is actually legal Fortran, but it is not possible to generate a C23-
+     compliant prototype for this, so we just record the fact here and
+     handle that during -fc-prototypes-external processing.  */
+
+  if (warn_external_argument_mismatch && csym && csym->attr.dummy
+      && csym->attr.external)
+    {
+      if (csym->formal)
+	{
+	  bool conflict;
+	  conflict = !gfc_compare_actual_formal (&c->ext.actual, csym->formal,
+						 0, 0, 0, NULL);
+	  if (conflict)
+	    {
+	      csym->ext_dummy_arglist_mismatch = 1;
+	      gfc_warning (OPT_Wexternal_argument_mismatch,
+			   "Different argument lists in external dummy "
+			   "subroutine %s at %L and %L", csym->name,
+			   &c->loc, &csym->formal_at);
+	    }
+	}
+      else
+	{
+	  gfc_get_formal_from_actual_arglist (csym, c->ext.actual);
+	  csym->formal_at = c->loc;
+	}
+    }
+
   t = true;
   if (c->resolved_sym == NULL)
     {
diff --git a/gcc/testsuite/gfortran.dg/interface_55.f90 b/gcc/testsuite/gfortran.dg/interface_55.f90
new file mode 100644
index 0000000..7016a56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_55.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-additional-options "-Wexternal-argument-mismatch" }
+! PR 119074 - the code is legal, but it makes sense to warn anyway.
+
+program main
+  external ex1,ex2
+  call foo(ex1,1)
+  call foo(ex2,2)
+end program main
+
+subroutine ex1(n)
+  integer :: n
+  if (n /= 1) error stop
+end subroutine ex1
+
+subroutine ex2(n,m)
+  integer :: n,m
+  if (n /= 2) error stop
+  if (m /= 3) error stop
+end subroutine ex2
+
+subroutine foo(a,n)
+  external a
+  if (n == 1) call a(1)   ! { dg-warning "Different argument lists" }
+  if (n == 2) call a(2,3) ! { dg-warning "Different argument lists" }
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/interface_56.f90 b/gcc/testsuite/gfortran.dg/interface_56.f90
new file mode 100644
index 0000000..c736c81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_56.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR 119074 - the code is legal, but it makes sense to warn anyway.
+! { dg-additional-options "-Wall" }
+
+program memain
+  external i1, i2
+  integer i1, i2
+  call foo (i1,1)
+  call foo (i2,2)
+end program memain
+
+integer function i1(n)
+  i1 = n + 1
+end function i1
+
+integer function i2(n,m)
+  i2 = n + m + 1
+end function i2
+
+subroutine foo(f,n)
+  integer, external :: f
+  integer :: n
+  integer :: s
+  if (n == 1) then
+     s = f(1)   ! { dg-warning "Different argument lists" }
+     if (s /= 2) error stop
+  end if
+  if (n == 2) then
+     s = f(2,3)  ! { dg-warning "Different argument lists" }
+     if (s /= 6) error stop
+  end if
+end subroutine foo