[PATCH] PR fortran/104812: generate error for constuct-name clash with symbols

[Mike Kashkarov <m.kashkarov@samsung.com>]

[-- Attachment #1: Type: text/plain, Size: 720 bytes --]


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.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr104812 --]
[-- Type: text/x-patch, Size: 5024 bytes --]

From 7c2749e3963733bf862fc58d3a068b0468a68c7f Mon Sep 17 00:00:00 2001
From: Mike Kashkarov <m.kashkarov@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.brainerd@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