Fortran: diagnostics of MODULE PROCEDURE declaration conflicts [PR104649]

gcc/fortran/ChangeLog:

	PR fortran/104649
	* decl.cc (gfc_match_formal_arglist): Handle conflicting declarations
	of a MODULE PROCEDURE when one of the declarations is an alternate
	return.

gcc/testsuite/ChangeLog:

	PR fortran/104649
	* gfortran.dg/pr104649.f90: New test.

Co-authored-by: Steven G. Kargl <kargl@gcc.gnu.org>

2 files changed, 61 insertions, 4 deletions

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index bdd3be3..4893c58 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -6796,12 +6796,25 @@ ok:
 	      || (p->next == NULL && q->next != NULL))
 	    arg_count_mismatch = true;
 	  else if ((p->sym == NULL && q->sym == NULL)
-		    || strcmp (p->sym->name, q->sym->name) == 0)
+		    || (p->sym && q->sym
+			&& strcmp (p->sym->name, q->sym->name) == 0))
 	    continue;
 	  else
-	    gfc_error_now ("Mismatch in MODULE PROCEDURE formal "
-			   "argument names (%s/%s) at %C",
-			   p->sym->name, q->sym->name);
+	    {
+	      if (q->sym == NULL)
+		gfc_error_now ("MODULE PROCEDURE formal argument %qs "
+			       "conflicts with alternate return at %C",
+			       p->sym->name);
+	      else if (p->sym == NULL)
+		gfc_error_now ("MODULE PROCEDURE formal argument is "
+			       "alternate return and conflicts with "
+			       "%qs in the separate declaration at %C",
+			       q->sym->name);
+	      else
+		gfc_error_now ("Mismatch in MODULE PROCEDURE formal "
+			       "argument names (%s/%s) at %C",
+			       p->sym->name, q->sym->name);
+	    }
 	}
 
       if (arg_count_mismatch)
diff --git a/gcc/testsuite/gfortran.dg/pr104649.f90 b/gcc/testsuite/gfortran.dg/pr104649.f90
new file mode 100644
index 0000000..f301ffc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104649.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-w" }
+! PR fortran/104649
+! Contributed by G.Steinmetz
+
+module m
+  interface
+    module subroutine s(x)
+      real :: x
+    end
+  end interface
+end
+submodule(m) m2
+contains
+  module subroutine s(*) ! { dg-error "conflicts with alternate return" }
+  end
+end
+
+module n
+  interface
+     module subroutine s(*)
+     end
+  end interface
+end
+submodule(n) n2
+contains
+  module subroutine s(x) ! { dg-error "formal argument is alternate return" }
+    real :: x
+  end
+end
+
+module p
+  interface
+     module subroutine s(x)
+       real :: x
+     end
+  end interface
+end
+submodule(p) p2
+contains
+  module subroutine s(y) ! { dg-error "Mismatch in MODULE PROCEDURE formal argument names" }
+    real :: y
+  end
+end