[flang-commits] [flang] ea2ff54 - [flang] Extension: forward refs to dummy args under IMPLICIT NONE
peter klausler via flang-commits
flang-commits at lists.llvm.org
Thu Feb 18 13:14:44 PST 2021
Author: peter klausler
Date: 2021-02-18T13:14:34-08:00
New Revision: ea2ff54ccc22f86f95e989d47daa669e0af950a8
URL: https://github.com/llvm/llvm-project/commit/ea2ff54ccc22f86f95e989d47daa669e0af950a8
DIFF: https://github.com/llvm/llvm-project/commit/ea2ff54ccc22f86f95e989d47daa669e0af950a8.diff
LOG: [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
Added:
flang/test/Semantics/resolve103.f90
Modified:
flang/docs/Extensions.md
flang/include/flang/Common/Fortran-features.h
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/assign04.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 9a057104ed6e..81c293221688 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -129,6 +129,11 @@ accepted if enabled by command-line options.
* 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/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 92eb61045796..0d8a59d8b82f 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -29,7 +29,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
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/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d1938901e633..7f14121d40b2 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -69,7 +69,8 @@ class ImplicitRules {
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 @@ class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
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 @@ class ScopeHandler : public ImplicitRulesVisitor {
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 @@ bool ImplicitRules::isImplicitNoneExternal() const {
}
}
-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,39 +2130,72 @@ static bool NeedsType(const Symbol &symbol) {
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.
@@ -2177,8 +2215,14 @@ void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
}
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 @@ bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
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 @@ bool DeclarationVisitor::CheckForHostAssociatedImplicit(
return false;
}
if (name.symbol) {
- ApplyImplicitRules(*name.symbol);
+ ApplyImplicitRules(*name.symbol, true);
}
Symbol *hostSymbol;
Scope *host{GetHostProcedure()};
@@ -6282,6 +6336,12 @@ void ResolveNamesVisitor::FinishSpecificationPart(
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/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index 1aa87d34af98..a88c3a5b69f4 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -126,7 +126,7 @@ real function f9() result(r)
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/flang/test/Semantics/resolve103.f90 b/flang/test/Semantics/resolve103.f90
new file mode 100644
index 000000000000..87f214a524b6
--- /dev/null
+++ b/flang/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
More information about the flang-commits
mailing list