[flang-commits] [flang] [flang] Allow forward reference to non-default INTEGER dummy (PR #141254)
via flang-commits
flang-commits at lists.llvm.org
Fri May 23 09:49:22 PDT 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
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 https://github.com/llvm/llvm-project/issues/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
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
``````````
</details>
https://github.com/llvm/llvm-project/pull/141254
More information about the flang-commits
mailing list