From: Harald Anlauf Date: Thu, 26 Oct 2023 20:32:35 +0000 (+0200) Subject: Fortran: diagnostics of MODULE PROCEDURE declaration conflicts [PR104649] X-Git-Tag: basepoints/gcc-15~5156 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c6430d3e6d3279c7e4be9d189031a17bb3dec347;p=thirdparty%2Fgcc.git 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 --- diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index bdd3be32a468..4893c5820650 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 000000000000..f301ffcde1f0 --- /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