[flang] Extension: forward refs to dummy args under IMPLICIT NONE

[klausler]

Summary

Most Fortran compilers accept the following benign extension,
and it appears in some applications:

SUBROUTINE FOO(A,N)
  IMPLICIT NONE
  REAL A(N) ! N is used before being typed
  INTEGER N
END

Allow it in f18 only for default integer scalar dummy arguments.

[clementval]

+1 I have seen this being used in many weather simulation code.

flang/docs/Extensions.md

 * DATA statement initialization is allowed for procedure pointers outside
   structure constructors.
 * Nonstandard intrinsic functions: ISNAN, SIZEOF
+* A forward reference to a default INTEGER scalar dummy argument is
+  permitted to appear in a specification expression, such as an array
+  bound, in a scope with IMPLICIT NONE(TYPE) if the name
+  of the dummy argument would have caused it to be implicitly typed
+  as default INTEGER if IMPLICIT NONE(TYPE) were absent.
 
 ### Extensions supported when enabled by options
 

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

     AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
-    ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways)
+    ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
+    ForwardRefDummyImplicitNone)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 

flang/lib/Semantics/resolve-names.cpp

   void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
   void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
   // Get the implicit type for this name. May be null.
-  const DeclTypeSpec *GetType(SourceName) const;
+  const DeclTypeSpec *GetType(
+      SourceName, bool respectImplicitNone = true) const;
   // Record the implicit type for the range of characters [fromLetter,
   // toLetter].
   void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,

   bool Pre(const parser::ImplicitSpec &);
   void Post(const parser::ImplicitSpec &);
 
-  const DeclTypeSpec *GetType(SourceName name) {
-    return implicitRules_->GetType(name);
+  const DeclTypeSpec *GetType(
+      SourceName name, bool respectImplicitNoneType = true) {
+    return implicitRules_->GetType(name, respectImplicitNoneType);
   }
   bool isImplicitNoneType() const {
     return implicitRules_->isImplicitNoneType();

 
 protected:
   // Apply the implicit type rules to this symbol.
-  void ApplyImplicitRules(Symbol &);
+  void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);
+  bool ImplicitlyTypeForwardRef(Symbol &);
   void AcquireIntrinsicProcedureFlags(Symbol &);
-  const DeclTypeSpec *GetImplicitType(Symbol &, const Scope &);
+  const DeclTypeSpec *GetImplicitType(
+      Symbol &, bool respectImplicitNoneType = true);
   bool ConvertToObjectEntity(Symbol &);
   bool ConvertToProcEntity(Symbol &);
 

   }
 }
 
-const DeclTypeSpec *ImplicitRules::GetType(SourceName name) const {
+const DeclTypeSpec *ImplicitRules::GetType(
+    SourceName name, bool respectImplicitNoneType) const {
   char ch{name.begin()[0]};
-  if (isImplicitNoneType_) {
+  if (isImplicitNoneType_ && respectImplicitNoneType) {
     return nullptr;
   } else if (auto it{map_.find(ch)}; it != map_.end()) {
     return &*it->second;
   } else if (inheritFromParent_) {
-    return parent_->GetType(name);
+    return parent_->GetType(name, respectImplicitNoneType);
   } else if (ch >= 'i' && ch <= 'n') {
     return &context_.MakeNumericType(TypeCategory::Integer);
   } else if (ch >= 'a' && ch <= 'z') {

           symbol.details());
 }
 
-void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
-  if (NeedsType(symbol)) {
-    const Scope *scope{&symbol.owner()};
-    if (scope->IsGlobal()) {
-      scope = &currScope();
+void ScopeHandler::ApplyImplicitRules(
+    Symbol &symbol, bool allowForwardReference) {
+  if (!NeedsType(symbol)) {
+    return;
+  }
+  if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
+    symbol.set(Symbol::Flag::Implicit);
+    symbol.SetType(*type);
+    return;
+  }
+  if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
+    std::optional<Symbol::Flag> functionOrSubroutineFlag;
+    if (symbol.test(Symbol::Flag::Function)) {
+      functionOrSubroutineFlag = Symbol::Flag::Function;
+    } else if (symbol.test(Symbol::Flag::Subroutine)) {
+      functionOrSubroutineFlag = Symbol::Flag::Subroutine;
     }
-    if (const DeclTypeSpec *
-        type{GetImplicitType(symbol, GetInclusiveScope(*scope))}) {
-      symbol.set(Symbol::Flag::Implicit);
-      symbol.SetType(*type);
+    if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
+      // type will be determined in expression semantics
+      AcquireIntrinsicProcedureFlags(symbol);
       return;
     }
-    if (symbol.has<ProcEntityDetails>() &&
-        !symbol.attrs().test(Attr::EXTERNAL)) {
-      std::optional<Symbol::Flag> functionOrSubroutineFlag;
-      if (symbol.test(Symbol::Flag::Function)) {
-        functionOrSubroutineFlag = Symbol::Flag::Function;
-      } else if (symbol.test(Symbol::Flag::Subroutine)) {
-        functionOrSubroutineFlag = Symbol::Flag::Subroutine;
-      }
-      if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
-        // type will be determined in expression semantics
-        AcquireIntrinsicProcedureFlags(symbol);
-        return;
-      }
-    }
-    if (!context().HasError(symbol)) {
-      Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
-      context().SetError(symbol);
-    }
+  }
+  if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
+    return;
+  }
+  if (!context().HasError(symbol)) {
+    Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
+    context().SetError(symbol);
   }
 }
 
+// Extension: Allow forward references to scalar integer dummy arguments
+// to appear in specification expressions under IMPLICIT NONE(TYPE) when
+// what would otherwise have been their implicit type is default INTEGER.
+bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
+  if (!inSpecificationPart_ || context().HasError(symbol) || !IsDummy(symbol) ||
+      symbol.Rank() != 0 ||
+      !context().languageFeatures().IsEnabled(
+          common::LanguageFeature::ForwardRefDummyImplicitNone)) {
+    return false;
+  }
+  const DeclTypeSpec *type{
+      GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
+  if (!type || !type->IsNumeric(TypeCategory::Integer)) {
+    return false;
+  }
+  auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
+  if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
+    return false;
+  }
+  if (!ConvertToObjectEntity(symbol)) {
+    return false;
+  }
+  // TODO: check no INTENT(OUT)?
+  if (context().languageFeatures().ShouldWarn(
+          common::LanguageFeature::ForwardRefDummyImplicitNone)) {
+    Say(symbol.name(),
+        "Dummy argument '%s' was used without being explicitly typed"_en_US,
+        symbol.name());
+  }
+  symbol.set(Symbol::Flag::Implicit);
+  symbol.SetType(*type);
+  return true;
+}
+
 // Ensure that the symbol for an intrinsic procedure is marked with
 // the INTRINSIC attribute.  Also set PURE &/or ELEMENTAL as
 // appropriate.

 }
 
 const DeclTypeSpec *ScopeHandler::GetImplicitType(
-    Symbol &symbol, const Scope &scope) {
-  const auto *type{implicitRulesMap_->at(&scope).GetType(symbol.name())};
+    Symbol &symbol, bool respectImplicitNoneType) {
+  const Scope *scope{&symbol.owner()};
+  if (scope->IsGlobal()) {
+    scope = &currScope();
+  }
+  scope = &GetInclusiveScope(*scope);
+  const auto *type{implicitRulesMap_->at(scope).GetType(
+      symbol.name(), respectImplicitNoneType)};
   if (type) {
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       // Resolve any forward-referenced derived type; a quick no-op else.

       context().SetError(symbol);
       return true;
     }
+    if (IsDummy(symbol) && isImplicitNoneType() &&
+        symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
+      // Dummy was implicitly typed despite IMPLICIT NONE(TYPE) in
+      // ApplyImplicitRules() due to use in a specification expression,
+      // and no explicit type declaration appeared later.
+      Say(symbol.name(),
+          "No explicit type declared for dummy argument '%s'"_err_en_US);
+      context().SetError(symbol);
+      return true;
+    }
   }
   return false;
 }

     return false;
   }
   if (name.symbol) {
-    ApplyImplicitRules(*name.symbol);
+    ApplyImplicitRules(*name.symbol, true);
   }
   Symbol *hostSymbol;
   Scope *host{GetHostProcedure()};

     if (NeedsExplicitType(symbol)) {
       ApplyImplicitRules(symbol);
     }
+    if (IsDummy(symbol) && isImplicitNoneType() &&
+        symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
+      Say(symbol.name(),
+          "No explicit type declared for dummy argument '%s'"_err_en_US);
+      context().SetError(symbol);
+    }
     if (symbol.has<GenericDetails>()) {
       CheckGenericProcedures(symbol);
     }

flang/test/Semantics/assign04.f90

   f9 = 1.0
 end
 
-!ERROR: No explicit type declared for 'n'
+!ERROR: No explicit type declared for dummy argument 'n'
 subroutine s10(a, n)
   implicit none
   real a(n)

flang/test/Semantics/resolve103.f90

+! RUN: not %f18 -Mstandard %s 2>&1 | FileCheck %s
+! Test extension: allow forward references to dummy arguments
+! from specification expressions in scopes with IMPLICIT NONE(TYPE),
+! as long as those symbols are eventually typed later with the
+! same integer type they would have had without IMPLICIT NONE.
+
+!CHECK: Dummy argument 'n1' was used without being explicitly typed
+!CHECK: error: No explicit type declared for dummy argument 'n1'
+subroutine foo1(a, n1)
+  implicit none
+  real a(n1)
+end
+
+!CHECK: Dummy argument 'n2' was used without being explicitly typed
+subroutine foo2(a, n2)
+  implicit none
+  real a(n2)
+!CHECK: error: The type of 'n2' has already been implicitly declared
+  double precision n2
+end
+
+!CHECK: Dummy argument 'n3' was used without being explicitly typed
+!CHECK-NOT: error:
+subroutine foo3(a, n3)
+  implicit none
+  real a(n3)
+  integer n3
+end