[flang-commits] [flang] [flang] Accept initialized SAVE local in specification expression (PR #107656)

via flang-commits flang-commits at lists.llvm.org
Fri Sep 6 16:36:43 PDT 2024


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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.

---
Full diff: https://github.com/llvm/llvm-project/pull/107656.diff


6 Files Affected:

- (modified) flang/docs/Extensions.md (+3) 
- (modified) flang/include/flang/Common/Fortran-features.h (+4-1) 
- (modified) flang/lib/Evaluate/check-expression.cpp (+15-2) 
- (modified) flang/test/Semantics/resolve69.f90 (+3-3) 
- (modified) flang/test/Semantics/resolve77.f90 (+1) 
- (modified) flang/test/Semantics/spec-expr.f90 (+1-1) 


``````````diff
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

``````````

</details>


https://github.com/llvm/llvm-project/pull/107656


More information about the flang-commits mailing list