[flang] Extension: forward refs to dummy args under IMPLICIT NONE
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.
Differential Revesion: https://reviews.llvm.org/D96982
GitOrigin-RevId: ea2ff54ccc22f86f95e989d47daa669e0af950a8
diff --git a/docs/Extensions.md b/docs/Extensions.md
index 9a05710..81c2932 100644
--- a/docs/Extensions.md
+++ b/docs/Extensions.md
@@ -129,6 +129,11 @@
* 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
diff --git a/include/flang/Common/Fortran-features.h b/include/flang/Common/Fortran-features.h
index 92eb610..0d8a59d 100644
--- a/include/flang/Common/Fortran-features.h
+++ b/include/flang/Common/Fortran-features.h
@@ -29,7 +29,8 @@
AdditionalFormats, BigIntLiterals, RealDoControls,
EquivalenceNumericWithCharacter, AdditionalIntrinsics, AnonymousParents,
OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
- ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways)
+ ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
+ ForwardRefDummyImplicitNone)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
diff --git a/lib/Semantics/resolve-names.cpp b/lib/Semantics/resolve-names.cpp
index d193890..7f14121 100644
--- a/lib/Semantics/resolve-names.cpp
+++ b/lib/Semantics/resolve-names.cpp
@@ -69,7 +69,8 @@
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,
@@ -380,8 +381,9 @@
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();
@@ -583,9 +585,11 @@
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 &);
@@ -1412,14 +1416,15 @@
}
}
-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') {
@@ -2125,37 +2130,70 @@
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
@@ -2177,8 +2215,14 @@
}
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.
@@ -2282,6 +2326,16 @@
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;
}
@@ -5731,7 +5785,7 @@
return false;
}
if (name.symbol) {
- ApplyImplicitRules(*name.symbol);
+ ApplyImplicitRules(*name.symbol, true);
}
Symbol *hostSymbol;
Scope *host{GetHostProcedure()};
@@ -6282,6 +6336,12 @@
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);
}
diff --git a/test/Semantics/assign04.f90 b/test/Semantics/assign04.f90
index 1aa87d3..a88c3a5 100644
--- a/test/Semantics/assign04.f90
+++ b/test/Semantics/assign04.f90
@@ -126,7 +126,7 @@
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)
diff --git a/test/Semantics/resolve103.f90 b/test/Semantics/resolve103.f90
new file mode 100644
index 0000000..87f214a
--- /dev/null
+++ b/test/Semantics/resolve103.f90
@@ -0,0 +1,28 @@
+! 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
