diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index fb57744c21570..a29493545135c 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -386,6 +386,9 @@ end probably by a C or C++ external definition. * An automatic data object may be declared in the specification part of the main program. +* A local data object may appear in a specification expression, even + when it is not a dummy argument or in COMMON, so long as it is + has the SAVE attribute and was initialized. ### 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 0c8a3d2bd5281..86c6e02b0f2ff 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -51,7 +51,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, BadBranchTarget, ConvertedArgument, HollerithPolymorphic, ListDirectedSize, NonBindCInteroperability, CudaManaged, CudaUnified, PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy, - UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr) + UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr, + SavedLocalInSpecExpr) // Portability and suspicious usage warnings ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, @@ -146,6 +147,8 @@ class LanguageFeatureControl { warnUsage_.set(UsageWarning::VectorSubscriptFinalization); warnUsage_.set(UsageWarning::UndefinedFunctionResult); warnUsage_.set(UsageWarning::UselessIomsg); + // New warnings, on by default + warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr); } LanguageFeatureControl(const LanguageFeatureControl &) = default; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index fef4620857a08..8a90404db0456 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -554,6 +554,18 @@ class CheckSpecificationExprHelper } } else if (&symbol.owner() != &scope_ || &ultimate.owner() != &scope_) { return std::nullopt; // host association is in play + } else if (semantics::IsSaved(ultimate) && + semantics::IsInitialized(ultimate) && + context_.languageFeatures().IsEnabled( + common::LanguageFeature::SavedLocalInSpecExpr)) { + if (!scope_.IsModuleFile() && + context_.languageFeatures().ShouldWarn( + common::LanguageFeature::SavedLocalInSpecExpr)) { + context_.messages().Say( + "specification expression refers to local object '%s' (initialized and saved)"_port_en_US, + ultimate.name().ToString()); + } + return std::nullopt; } else if (const auto *object{ ultimate.detailsIf()}) { if (object->commonBlock()) { @@ -781,8 +793,9 @@ bool CheckSpecificationExprHelper::IsPermissibleInquiry( template void CheckSpecificationExpr(const A &x, const semantics::Scope &scope, FoldingContext &context, bool forElementalFunctionResult) { - if (auto why{CheckSpecificationExprHelper{ - scope, context, forElementalFunctionResult}(x)}) { + CheckSpecificationExprHelper helper{ + scope, context, forElementalFunctionResult}; + if (auto why{helper(x)}) { context.messages().Say("Invalid specification expression%s: %s"_err_en_US, forElementalFunctionResult ? " for elemental function result" : "", *why); diff --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90 index e1f7773eee9da..5acfd30604fe3 100644 --- a/flang/test/Semantics/resolve69.f90 +++ b/flang/test/Semantics/resolve69.f90 @@ -16,7 +16,7 @@ subroutine s1() ! integer, parameter :: constVal = 1 integer :: nonConstVal = 1 -!ERROR: Invalid specification expression: reference to local entity 'nonconstval' +!PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved) character(nonConstVal) :: colonString1 character(len=20, kind=constVal + 1) :: constKindString character(len=:, kind=constVal + 1), pointer :: constKindString1 @@ -53,13 +53,13 @@ function foo3() type (derived(constVal, 3)) :: constDerivedKind !ERROR: Value of KIND type parameter 'typekind' must be constant -!ERROR: Invalid specification expression: reference to local entity 'nonconstval' +!PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved) type (derived(nonConstVal, 3)) :: nonConstDerivedKind !OK because all type-params are constants type (derived(3, constVal)) :: constDerivedLen -!ERROR: Invalid specification expression: reference to local entity 'nonconstval' +!PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved) type (derived(3, nonConstVal)) :: nonConstDerivedLen !ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer type (derived(3, :)) :: colonDerivedLen diff --git a/flang/test/Semantics/resolve77.f90 b/flang/test/Semantics/resolve77.f90 index 943993ee74d76..0133fac3bfbc5 100644 --- a/flang/test/Semantics/resolve77.f90 +++ b/flang/test/Semantics/resolve77.f90 @@ -60,6 +60,7 @@ pure integer function if2(n) block data common /blk2/ n data n/100/ + !PORTABILITY: specification expression refers to local object 'n' (initialized and saved) !ERROR: Automatic data object 'a' may not appear in a BLOCK DATA subprogram real a(n) end diff --git a/flang/test/Semantics/spec-expr.f90 b/flang/test/Semantics/spec-expr.f90 index aa010ed0bf7ed..9d209c3583b43 100644 --- a/flang/test/Semantics/spec-expr.f90 +++ b/flang/test/Semantics/spec-expr.f90 @@ -104,7 +104,7 @@ subroutine s7biii(x, y) integer :: local = 5 ! OK, since "localConst" is a constant real, dimension(localConst) :: realArray1 - !ERROR: Invalid specification expression: reference to local entity 'local' + !PORTABILITY: specification expression refers to local object 'local' (initialized and saved) real, dimension(local) :: realArray2 real, dimension(size(realArray1)) :: realArray3 ! ok real, dimension(size(x)) :: realArray4 ! ok