From 109e21c35fbec2b97bfa07ad76e79806469d615c Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Fri, 6 Sep 2024 15:48:21 -0700 Subject: [PATCH] [flang] Accept initialized SAVE local in specification expression Specification expressions may contain references to dummy arguments, host objects, module variables, and variables in COMMON blocks, since they will have values on entry to the scope. A local variable with a initializer and the SAVE attribute (which will always be implied by an explicit initialization) will also always work, and is accepted by at least one other compiler, so accept it with a warning. --- flang/docs/Extensions.md | 3 +++ flang/include/flang/Common/Fortran-features.h | 5 ++++- flang/lib/Evaluate/check-expression.cpp | 17 +++++++++++++++-- flang/test/Semantics/resolve69.f90 | 6 +++--- flang/test/Semantics/resolve77.f90 | 1 + flang/test/Semantics/spec-expr.f90 | 2 +- 6 files changed, 27 insertions(+), 7 deletions(-) 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