[flang-commits] [flang] [flang] Accept initialized SAVE local in specification expression (PR #107656)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Sep 6 16:36:10 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/107656
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.
>From 109e21c35fbec2b97bfa07ad76e79806469d615c Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
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 fb57744c215703..a29493545135cf 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 0c8a3d2bd5281f..86c6e02b0f2ffd 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 fef4620857a08a..8a90404db0456c 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<semantics::ObjectEntityDetails>()}) {
if (object->commonBlock()) {
@@ -781,8 +793,9 @@ bool CheckSpecificationExprHelper::IsPermissibleInquiry(
template <typename A>
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 e1f7773eee9da0..5acfd30604fe31 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 943993ee74d76e..0133fac3bfbc5d 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 aa010ed0bf7ed1..9d209c3583b434 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
More information about the flang-commits
mailing list