Greetings,
Propose patch for https://gcc.gnu.org/bugzilla/show_bug.cgi?id=104812 to
reject non-conforming code when construct-name clashes with already
defined symbol names, e.g:
subroutine s1
logical :: x
x: if (x) then ! Currently gfortran accepts 'x' as constuct-name
end if x
end
Steve Kargl poited that (Fortran 2018, 19.4, p 498):
Identifiers of entities, other than statement or construct entities (19.4),
in the classes
(1) named variables, ..., named constructs, ...,
Within its scope, a local identifier of one class shall not be the
same as another local identifier of the same class,
Regtested on x86_64-pc-linux-gnu, OK for mainline?
Thanks.
>From 7c2749e3963733bf862fc58d3a068b0468a68c7f Mon Sep 17 00:00:00 2001
From: Mike Kashkarov <m.kashka...@samsung.com>
Date: Mon, 14 Mar 2022 12:31:23 +0900
Subject: [PATCH] PR fortran/104812: generate error for constuct-name clash with symbols
gcc/fortran/ChangeLog:
PR fortran/104812
* match.cc (gfc_match_label): Add new error message if constuct-name
conflicts with other symbols in scope.
gcc/testsuite/ChangeLog:
PR fortran/102332
* gcc/testsuite/gfortran.dg/pr104812.f90: New test.
* gcc/testsuite/gfortran.dg/pr65045.f90: Update.
---
gcc/fortran/match.cc | 17 +++++++++++++
gcc/testsuite/gfortran.dg/pr104812.f90 | 35 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pr65045.f90 | 17 ++++++-------
3 files changed, 60 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr104812.f90
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8edfe4a3a2d..8226fd4322b 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -576,6 +576,7 @@ cleanup:
static match
gfc_match_label (void)
{
+ gfc_symtree *st;
char name[GFC_MAX_SYMBOL_LEN + 1];
match m;
@@ -585,6 +586,15 @@ gfc_match_label (void)
if (m != MATCH_YES)
return m;
+ // Check if we have symbol with matched name in scope.
+ // From 19.3.1:
+ // Identifiers of entities, other than statement or construct entities (19.4),
+ // in the classes
+ // (1) named variables, ..., named constructs, ...,
+ // Within its scope, a local identifier of one class shall not be the
+ // same as another local identifier of the same class, ...
+ st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
if (gfc_get_symbol (name, NULL, &gfc_new_block))
{
gfc_error ("Label name %qs at %C is ambiguous", name);
@@ -597,6 +607,13 @@ gfc_match_label (void)
return MATCH_ERROR;
}
+ if (st != 0)
+ {
+ gfc_error ("Construct label %qs at %C already defined here %L", name,
+ &st->n.sym->declared_at);
+ return MATCH_ERROR;
+ }
+
if (!gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
gfc_new_block->name, NULL))
return MATCH_ERROR;
diff --git a/gcc/testsuite/gfortran.dg/pr104812.f90 b/gcc/testsuite/gfortran.dg/pr104812.f90
new file mode 100644
index 00000000000..d103e93a184
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104812.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+
+subroutine s0
+ logical :: x ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ x: block ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ end block x ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine s1
+ logical :: x ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ x: if (.true.) ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ endif x ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine s2
+ logical :: x ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ real :: y ! { dg-error "Construct label .y. at .1. already defined here .2." }
+
+ x: block ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ end block x ! { dg-error "Expecting END SUBROUTINE" }
+
+ y: block ! { dg-error "Construct label .y. at .1. already defined here .2." }
+ end block y ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine s3
+ logical :: x ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ real :: y ! { dg-error "Construct label .y. at .1. already defined here .2." }
+
+ x: if (.true.) ! { dg-error "Construct label .x. at .1. already defined here .2." }
+ endif x ! { dg-error "Expecting END SUBROUTINE" }
+
+ y: if (.true.) ! { dg-error "Construct label .y. at .1. already defined here .2." }
+ endif y ! { dg-error "Expecting END SUBROUTINE" }
+end
diff --git a/gcc/testsuite/gfortran.dg/pr65045.f90 b/gcc/testsuite/gfortran.dg/pr65045.f90
index c49652993d7..eba4f5d2882 100644
--- a/gcc/testsuite/gfortran.dg/pr65045.f90
+++ b/gcc/testsuite/gfortran.dg/pr65045.f90
@@ -2,14 +2,13 @@
!
! Contributed by Walt Brainerd <walt.brain...@gmail.com>
!
-real :: i = 9.9
-i:block
- if (i>7.7) then ! { dg-error "is not appropriate for an expression" }
- exit i
- else ! { dg-error "Unexpected ELSE statement" }
- i = 2.2 ! { dg-error "is not a variable" }
- end if ! { dg-error "Expecting END BLOCK statement" }
+real :: i = 9.9 ! { dg-error "Construct label .i. at .1. already defined here .2." }
+i:block ! { dg-error "Construct label .i. at .1. already defined here .2." }
+ if (i>7.7) then
+ exit i ! { dg-error "Name .i. in EXIT statement at .1. is not a construct name" }
+ else
+ i = 2.2
+ end if
end block i ! { dg-error "Expecting END PROGRAM statement" }
-print*,i ! { dg-error "not appropriate for an expression" }
+print*,i
end
-! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
--
2.35.1
