The attach patch checks that a statement function name
does not conflict the name of the containing function.
Regression tested on x86_64-*-freebsd. OK to commit?
2019-08-16 Steven G. Kargl
PR fortran/78739
* match.c (gfc_match_st_function): When matching a statement function,
need to check if the statement function name shadows the function
name.
2019-08-16 Steven G. Kargl
PR fortran/78739
* fortran.dg/pr78739.f90: New test.
--
Steve
Index: gcc/fortran/match.c
===
--- gcc/fortran/match.c (revision 274578)
+++ gcc/fortran/match.c (working copy)
@@ -5751,7 +5751,29 @@ gfc_match_st_function (void)
gfc_symbol *sym;
gfc_expr *expr;
match m;
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ locus old_locus;
+ bool fcn;
+ gfc_formal_arglist *ptr;
+ /* Read the possible statement function name, and then check to see if
+ a symbol is already present in the namespace. Record if it is a
+ function and whether it has been referenced. */
+ fcn = false;
+ ptr = NULL;
+ old_locus = gfc_current_locus;
+ m = gfc_match_name (name);
+ if (m == MATCH_YES)
+{
+ gfc_find_symbol (name, NULL, 1, );
+ if (sym && sym->attr.function && !sym->attr.referenced)
+ {
+ fcn = true;
+ ptr = sym->formal;
+ }
+}
+
+ gfc_current_locus = old_locus;
m = gfc_match_symbol (, 0);
if (m != MATCH_YES)
return m;
@@ -5776,6 +5798,13 @@ gfc_match_st_function (void)
if (recursive_stmt_fcn (expr, sym))
{
gfc_error ("Statement function at %L is recursive", >where);
+ return MATCH_ERROR;
+}
+
+ if (fcn && ptr != sym->formal)
+{
+ gfc_error ("Statement function %qs at %L conflicts with function name",
+ sym->name, >where);
return MATCH_ERROR;
}
Index: gcc/testsuite/gfortran.dg/pr78739.f90
===
--- gcc/testsuite/gfortran.dg/pr78739.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78739.f90 (working copy)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-w" }
+! PR fortran/78739
+! Code contributed Gerhard Steinmetz
+function f(n)
+ f() = n! { dg-error "conflicts with function name" }
+end
+
+function g()
+ g(x) = x ! { dg-error "conflicts with function name" }
+end
+
+function a() ! This should cause an error, but cannot be easily detected!
+ a() = x
+end
