[flang] Allow to use already existing names for contruct-name

[FruitClover]

Summary

Relax reference checks to allow reuse ObjectEntries names in scope for newerly
created construct-name.

Fortran has restriction that for do-construct-name corresponding end-do shall
be at end-do-stmt specifying the same do-construct-name, and gfortran/nvfortran
allows to reuse names from objects.

[klausler]

flang/lib/Semantics/resolve-names.cpp

614

"details" is being passed by value; perhaps a const reference would be better.

615

Two things here: first, this doesn't need to be an if statement, it can be just a simple return statement.

Second, why allow this only for object entities? Wouldn't any symbol other than another construct name be allowable?

[FruitClover]

flang/lib/Semantics/resolve-names.cpp

615

Second, why allow this only for object entities? Wouldn't any symbol other than another construct name be allowable?

You are right and actually there is uncovered case when variable named as construct-name used inside construct scope: (from Fortran 2018, 19.3, also asked gfortran folks here https://gcc.gnu.org/bugzilla/show_bug.cgi?id=104812 to be sure)

subroutine s1
  logical :: x
  x: if (x) then  ! should be an error
  end if x
end

Is ScopeHandler::PushScope the right place for such fix or it should be done in expression.cpp?

[klausler]

Please consult subclause 19.3.1 of the Fortran 2018 standard. Named constructs are in the same class as most other local entities. I don't think that what you're trying to do here is standard-conforming.

[FruitClover]

In D120973#3370067, @klausler wrote:

Please consult subclause 19.3.1 of the Fortran 2018 standard. Named constructs are in the same class as most other local entities. I don't think that what you're trying to do here is standard-conforming.

Thanks, flang is right and current PR was based on gfortran behavior that accepts non-conforming code for corner cases, proposed fix https://gcc.gnu.org/bugzilla/show_bug.cgi?id=104812 to gfortran instead.
Closed.

flang/lib/Semantics/resolve-names.cpp

if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
                 &currScope().MakeSymbol(name, attrs, std::move(details));
             d->set_derivedType(*derivedType);
           } else {
             SayAlreadyDeclared(name, *derivedType);
           }
           return *derivedType;
         }
       }
+    } else if constexpr (std::is_same_v<MiscDetails, D>) {
+      if (isSameSymbolNameAllowed(*symbol, details)) {
+        symbol = &MakeSymbol(name, attrs);
+        if (symbol->CanReplaceDetails(details)) {
+          symbol->set_details(std::move(details));
+        }
+        return *symbol;
+      }
     }
     if (symbol->CanReplaceDetails(details)) {
       // update the existing symbol
       symbol->attrs() |= attrs;
       if constexpr (std::is_same_v<SubprogramDetails, D>) {
         // Dummy argument defined by explicit interface
         details.set_isDummy(IsDummy(*symbol));
       }
protected:
 
   const DeclTypeSpec &MakeNumericType(
       TypeCategory, const std::optional<parser::KindSelector> &);
   const DeclTypeSpec &MakeLogicalType(
       const std::optional<parser::KindSelector> &);
   void NotePossibleBadForwardRef(const parser::Name &);
   std::optional<SourceName> HadForwardRef(const Symbol &) const;
   bool CheckPossibleBadForwardRef(const Symbol &);
+  bool isSameSymbolNameAllowed(Symbol &symbol, MiscDetails details) {
+    if (details.kind() == MiscDetails::Kind::ConstructName &&
+        symbol.has<ObjectEntityDetails>()) {
+      return true;
+    }
+    return false;
+  }
 
   bool inExecutionPart_{false};
   bool inSpecificationPart_{false};
   bool inEquivalenceStmt_{false};
 
   // Some information is collected from a specification part for deferred
   // processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts())
   // that are called by ResolveNamesVisitor::FinishSpecificationPart().  Since

flang/test/Semantics/resolve35.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Construct names
 
 subroutine s1
   real :: foo
+  foo: block
+  end block foo
+end
+
+subroutine s1b
+  foo: block
+  end block foo
   !ERROR: 'foo' is already declared in this scoping unit
   foo: block
   end block foo
 end
 
 subroutine s2(x)
   logical :: x
   foo: if (x) then
   end if foo
   !ERROR: 'foo' is already declared in this scoping unit
   foo: do i = 1, 10
   end do foo
 end
 
+subroutine s2b(x)
+  logical :: x
+  x: if (x) then
+  end if x
+end
+
 subroutine s3
   real :: a(10,10), b(10,10)
   type y; end type
   integer(8) :: x
   !ERROR: Index name 'y' conflicts with existing identifier
   forall(x=1:10, y=1:10)
     a(x, y) = b(x, y)
   end forall