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>
This commit is contained in:
Harald Anlauf 2023-10-26 22:32:35 +02:00
parent 9f3c4c673d
commit c6430d3e6d
2 changed files with 61 additions and 4 deletions

View file

@ -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)

View file

@ -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