diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/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/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/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; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/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,39 +2130,72 @@ 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() && !symbol.attrs().test(Attr::EXTERNAL)) { + std::optional 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() && - !symbol.attrs().test(Attr::EXTERNAL)) { - std::optional 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 @@ } 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()) { CheckGenericProcedures(symbol); } diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90 --- a/flang/test/Semantics/assign04.f90 +++ b/flang/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/flang/test/Semantics/resolve103.f90 b/flang/test/Semantics/resolve103.f90 new file mode 100644 --- /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