[flang] Extension: allow DATA to precede declaration under IMPLICIT NONE(TYPE)

[klausler]

Summary

It is not standard conforming under IMPLICIT NONE(TYPE) for a name to
appear in a DATA statement prior to its explicit type declaration,
but it is benign, supported in other compilers, and attested in real
applications. Support it with an optional portability warning.

Fixes GitHub LLVM bug https://github.com/llvm/llvm-project/issues/63783.

[kiranchandramohan]

LG. Thanks @klausler.

[kiranchandramohan]

One of the gfortran testsuite tests is failing, possibly with this change.
https://lab.llvm.org/buildbot/#/builders/179/builds/6694
https://github.com/llvm/llvm-test-suite/blob/main/Fortran/gfortran/regression/blockdata_4.f90

[klausler]

In D155496#4509700, @kiranchandramohan wrote:

One of the gfortran testsuite tests is failing, possibly with this change.
https://lab.llvm.org/buildbot/#/builders/179/builds/6694
https://github.com/llvm/llvm-test-suite/blob/main/Fortran/gfortran/regression/blockdata_4.f90

That test now compiles, which was probably an unexpected result. I'll see whether I can modify the suite.

flang/docs/Extensions.md

   may be distinct from the constant character length, if any,
   of an allocated object.
 * When a name is brought into a scope by multiple ways,
   such as USE-association as well as an `IMPORT` from its host,
   it's an error only if the resolution is ambiguous.
+* An entity may appear in a `DATA` statement before its explicit
+  type declaration under `IMPLICIT NONE(TYPE)`.
 
 ### Extensions supported when enabled by options
 
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]

flang/include/flang/Common/Fortran-features.h

     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
     ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables,
-    DistinctArrayConstructorLengths, PPCVector, RelaxedIntentInChecking)
+    DistinctArrayConstructorLengths, PPCVector, RelaxedIntentInChecking,
+    ForwardRefImplicitNoneData)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
     ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,

flang/lib/Semantics/resolve-names.cpp

   void NotePossibleBadForwardRef(const parser::Name &);
   std::optional<SourceName> HadForwardRef(const Symbol &) const;
   bool CheckPossibleBadForwardRef(const Symbol &);
 
   bool inSpecificationPart_{false};
+  bool inDataStmtObject_{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

     // Dummy argument, no declaration or reference; if it turns
     // out to be a subroutine, it's fine, and if it is a function
     // or object, it'll be caught later.
     return;
   }
+  if (inDataStmtObject_) {
+    return;
+  }
   if (!context().HasError(symbol)) {
     Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
     context().SetError(symbol);
   }
 }

 const DeclTypeSpec &ScopeHandler::MakeLogicalType(int kind) {
   return context().MakeLogicalType(kind);
 }
 
 void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
-  if (inSpecificationPart_ && name.symbol) {
+  if (inSpecificationPart_ && !inDataStmtObject_ && name.symbol) {
     auto kind{currScope().kind()};
     if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
         kind == Scope::Kind::BlockConstruct) {
       bool isHostAssociated{&name.symbol->owner() == &currScope()
               ? name.symbol->has<HostAssocDetails>()

       return;
     }
   }
   auto *prevType{symbol.GetType()};
   if (!prevType) {
+    if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType() &&
+        context().ShouldWarn(
+            common::LanguageFeature::ForwardRefImplicitNoneData)) {
+      Say(name,
+          "'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US);
+    }
     symbol.SetType(type);
   } else if (symbol.has<UseDetails>()) {
     // error recovery case, redeclaration of use-associated name
   } else if (HadForwardRef(symbol)) {
     // error recovery after use of host-associated name

   // When a name first appears as an object in a DATA statement, it should
   // be implicitly declared locally as if it had been assigned.
   auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
   common::visit(common::visitors{
                     [&](const Indirection<parser::Variable> &y) {
+                      auto restorer{common::ScopedSet(inDataStmtObject_, true)};
                       Walk(y.value());
                       const parser::Name &first{
                           parser::GetFirstName(y.value())};
                       if (first.symbol) {
                         first.symbol->set(Symbol::Flag::InDataStmt);

           "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
           name.source);
     }
     return &name;
   }
-  if (isImplicitNoneType()) {
+  if (isImplicitNoneType() && !inDataStmtObject_) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
   // Create the symbol then ensure it is accessible
   if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {

flang/test/Semantics/resolve30.f90

-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 subroutine s1
   integer x
   block
     import, none
     !ERROR: 'x' from host scoping unit is not accessible due to IMPORT

   real :: a(16) = [(x, x=1, 16)]
   real :: b(16)
   !ERROR: Must have INTEGER type, but is REAL(4)
   data(b(j), j=1, 16) / 16 * 0.0 /
 end
+
+subroutine s5
+  implicit none
+  data x/1./
+  !PORTABILITY: 'x' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)
+  real x
+end