[flang] Allow forward reference to non-default INTEGER dummy

[klausler]

A dummy argument with an explicit INTEGER type of non-default kind can be forward-referenced from a specification expression in many Fortran compilers. Handle by adding type declaration statements to the initial pass over a specification part's declaration constructs. Emit an optional warning under -pedantic.

Fixes #140941.

[llvmbot]

@llvm/pr-subscribers-flang-openmp

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

A dummy argument with an explicit INTEGER type of non-default kind can be forward-referenced from a specification expression in many Fortran compilers. Handle by adding type declaration statements to the initial pass over a specification part's declaration constructs. Emit an optional warning under -pedantic.

Fixes #140941.

---

Full diff: https://github.com/llvm/llvm-project/pull/141254.diff

4 Files Affected:

• (modified) flang/docs/Extensions.md (+4-1)
• (modified) flang/lib/Semantics/resolve-names.cpp (+72-3)
• (modified) flang/test/Semantics/OpenMP/linear-clause01.f90 (-2)
• (modified) flang/test/Semantics/resolve103.f90 (+9-7)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 00a7e2bac84e6..e3501dffb8777 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -291,7 +291,10 @@ end
 * 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 or
+* A forward reference to an INTEGER dummy argument is permitted to appear
+  in a specification expression, such as an array bound, in a scope with
+  IMPLICIT NONE(TYPE).
+* A forward reference to a default INTEGER scalar
   `COMMON` block variable 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 variable would have caused it to be implicitly typed
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index bdafc03ad2c05..e910a910a86f6 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -768,10 +768,22 @@ class ScopeHandler : public ImplicitRulesVisitor {
     deferImplicitTyping_ = skipImplicitTyping_ = skip;
   }
 
+  void NoteEarlyDeclaredDummyArgument(Symbol &symbol) {
+    earlyDeclaredDummyArguments_.insert(symbol);
+  }
+  bool IsEarlyDeclaredDummyArgument(Symbol &symbol) {
+    return earlyDeclaredDummyArguments_.find(symbol) !=
+        earlyDeclaredDummyArguments_.end();
+  }
+  void ForgetEarlyDeclaredDummyArgument(Symbol &symbol) {
+    earlyDeclaredDummyArguments_.erase(symbol);
+  }
+
 private:
   Scope *currScope_{nullptr};
   FuncResultStack funcResultStack_{*this};
   std::map<Scope *, DeferredDeclarationState> deferred_;
+  UnorderedSymbolSet earlyDeclaredDummyArguments_;
 };
 
 class ModuleVisitor : public virtual ScopeHandler {
@@ -1119,6 +1131,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   template <typename T>
   Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
     Symbol &symbol{MakeSymbol(name, attrs)};
+    ForgetEarlyDeclaredDummyArgument(symbol);
     if (context().HasError(symbol) || symbol.has<T>()) {
       return symbol; // OK or error already reported
     } else if (symbol.has<UnknownDetails>()) {
@@ -1976,6 +1989,9 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
   Scope &topScope_;
 
   void PreSpecificationConstruct(const parser::SpecificationConstruct &);
+  void EarlyDummyTypeDeclaration(
+      const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
+          &);
   void CreateCommonBlockSymbols(const parser::CommonStmt &);
   void CreateObjectSymbols(const std::list<parser::ObjectDecl> &, Attr);
   void CreateGeneric(const parser::GenericSpec &);
@@ -8488,13 +8504,24 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
     symbol->set(Symbol::Flag::ImplicitOrError, false);
     if (IsUplevelReference(*symbol)) {
       MakeHostAssocSymbol(name, *symbol);
-    } else if (IsDummy(*symbol) ||
-        (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
+    } else if (IsDummy(*symbol)) {
       CheckEntryDummyUse(name.source, symbol);
+      ConvertToObjectEntity(*symbol);
+      if (IsEarlyDeclaredDummyArgument(*symbol)) {
+        ForgetEarlyDeclaredDummyArgument(*symbol);
+        if (isImplicitNoneType()) {
+          context().Warn(common::LanguageFeature::ForwardRefImplicitNone,
+              name.source,
+              "'%s' was used under IMPLICIT NONE(TYPE) before being explicitly typed"_warn_en_US,
+              name.source);
+        }
+      }
+      ApplyImplicitRules(*symbol);
+    } else if (!symbol->GetType() && FindCommonBlockContaining(*symbol)) {
       ConvertToObjectEntity(*symbol);
       ApplyImplicitRules(*symbol);
     } else if (const auto *tpd{symbol->detailsIf<TypeParamDetails>()};
-               tpd && !tpd->attr()) {
+        tpd && !tpd->attr()) {
       Say(name,
           "Type parameter '%s' was referenced before being declared"_err_en_US,
           name.source);
@@ -9258,6 +9285,10 @@ void ResolveNamesVisitor::PreSpecificationConstruct(
     const parser::SpecificationConstruct &spec) {
   common::visit(
       common::visitors{
+          [&](const parser::Statement<
+              common::Indirection<parser::TypeDeclarationStmt>> &y) {
+            EarlyDummyTypeDeclaration(y);
+          },
           [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
             CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
           },
@@ -9286,6 +9317,44 @@ void ResolveNamesVisitor::PreSpecificationConstruct(
       spec.u);
 }
 
+void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
+    const parser::Statement<common::Indirection<parser::TypeDeclarationStmt>>
+        &stmt) {
+  context().set_location(stmt.source);
+  const auto &[declTypeSpec, attrs, entities] = stmt.statement.value().t;
+  if (const auto *intrin{
+          std::get_if<parser::IntrinsicTypeSpec>(&declTypeSpec.u)}) {
+    if (const auto *intType{std::get_if<parser::IntegerTypeSpec>(&intrin->u)}) {
+      if (const auto &kind{intType->v}) {
+        if (!parser::Unwrap<parser::KindSelector::StarSize>(*kind) &&
+            !parser::Unwrap<parser::IntLiteralConstant>(*kind)) {
+          return;
+        }
+      }
+      const DeclTypeSpec *type{nullptr};
+      for (const auto &ent : entities) {
+        const auto &objName{std::get<parser::ObjectName>(ent.t)};
+        Resolve(objName, FindInScope(currScope(), objName));
+        if (Symbol * symbol{objName.symbol};
+            symbol && IsDummy(*symbol) && NeedsType(*symbol)) {
+          if (!type) {
+            type = ProcessTypeSpec(declTypeSpec);
+            if (!type || !type->IsNumeric(TypeCategory::Integer)) {
+              break;
+            }
+          }
+          symbol->SetType(*type);
+          NoteEarlyDeclaredDummyArgument(*symbol);
+          // Set the Implicit flag to disable bogus errors from
+          // being emitted later when this declaration is processed
+          // again normally.
+          symbol->set(Symbol::Flag::Implicit);
+        }
+      }
+    }
+  }
+}
+
 void ResolveNamesVisitor::CreateCommonBlockSymbols(
     const parser::CommonStmt &commonStmt) {
   for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
diff --git a/flang/test/Semantics/OpenMP/linear-clause01.f90 b/flang/test/Semantics/OpenMP/linear-clause01.f90
index f95e834c9026c..286def2dba119 100644
--- a/flang/test/Semantics/OpenMP/linear-clause01.f90
+++ b/flang/test/Semantics/OpenMP/linear-clause01.f90
@@ -20,10 +20,8 @@ subroutine linear_clause_02(arg_01, arg_02)
     !$omp declare simd linear(val(arg_01))
     real, intent(in) :: arg_01(:)
 
-    !ERROR: The list item 'arg_02' specified without the REF 'linear-modifier' must be of INTEGER type
     !ERROR: If the `linear-modifier` is REF or UVAL, the list item 'arg_02' must be a dummy argument without the VALUE attribute
     !$omp declare simd linear(uval(arg_02))
-    !ERROR: The type of 'arg_02' has already been implicitly declared
     integer, value, intent(in) :: arg_02
 
     !ERROR: The list item 'var' specified without the REF 'linear-modifier' must be of INTEGER type
diff --git a/flang/test/Semantics/resolve103.f90 b/flang/test/Semantics/resolve103.f90
index 8f55968f43375..0acf2333b9586 100644
--- a/flang/test/Semantics/resolve103.f90
+++ b/flang/test/Semantics/resolve103.f90
@@ -1,8 +1,7 @@
 ! RUN: not %flang_fc1 -pedantic %s 2>&1 | FileCheck %s
 ! Test extension: allow forward references to dummy arguments or COMMON
 ! 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.
+! as long as those symbols are eventually typed later.
 
 !CHECK: warning: 'n1' was used without (or before) being explicitly typed
 !CHECK: error: No explicit type declared for dummy argument 'n1'
@@ -19,12 +18,15 @@ subroutine foo2(a, n2)
   double precision n2
 end
 
-!CHECK: warning: 'n3' was used without (or before) being explicitly typed
-!CHECK-NOT: error: Dummy argument 'n3'
-subroutine foo3(a, n3)
+!CHECK: warning: 'n3a' was used under IMPLICIT NONE(TYPE) before being explicitly typed
+!CHECK: warning: 'n3b' was used under IMPLICIT NONE(TYPE) before being explicitly typed
+!CHECK-NOT: error: Dummy argument 'n3a'
+!CHECK-NOT: error: Dummy argument 'n3b'
+subroutine foo3(a, n3a, n3b)
   implicit none
-  real a(n3)
-  integer n3
+  integer a(n3a, n3b)
+  integer n3a
+  integer(8) n3b
 end
 
 !CHECK: warning: 'n4' was used without (or before) being explicitly typed