From 9d591a73f070e6090b7c59dca928b84b1c261d92 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 26 Oct 2023 22:32:35 +0200
Subject: [PATCH] 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>
---
gcc/fortran/decl.cc | 21 +++++++++---
gcc/testsuite/gfortran.dg/pr104649.f90 | 44 ++++++++++++++++++++++++++
2 files changed, 61 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr104649.f90
@@ -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)
new file mode 100644
@@ -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
--
2.35.3