From 9d591a73f070e6090b7c59dca928b84b1c261d92 Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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 --- 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 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index bdd3be32a46..4893c582065 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 00000000000..f301ffcde1f --- /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 -- 2.35.3