[flang-commits] [flang] 625dedc - [flang] Allow modification of construct entities

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Thu Apr 14 16:58:17 PDT 2022


Author: Peter Klausler
Date: 2022-04-14T16:58:08-07:00
New Revision: 625dedc3fe60f1b1010a96c9fee43119f6dfe121

URL: https://github.com/llvm/llvm-project/commit/625dedc3fe60f1b1010a96c9fee43119f6dfe121
DIFF: https://github.com/llvm/llvm-project/commit/625dedc3fe60f1b1010a96c9fee43119f6dfe121.diff

LOG: [flang] Allow modification of construct entities

Construct entities from ASSOCIATE, SELECT TYPE, and SELECT RANK
are modifiable if the are associated with modifiable variables
without vector subscripts.  Update WhyNotModifiable() to accept
construct entities that are appropriate.

A need for more general error reporting from one overload of
WhyNotModifiable() caused its result type to change to
std::optional<parser::Message> instead of ::MessageFixedText,
and this change had some consequences that rippled through
call sites.

Some test results that didn't allow for modifiable construct
entities needed to be updated.

Differential Revision: https://reviews.llvm.org/D123722

Added: 
    

Modified: 
    flang/include/flang/Semantics/tools.h
    flang/lib/Semantics/check-omp-structure.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/tools.cpp
    flang/test/Semantics/modifiable01.f90
    flang/test/Semantics/resolve57.f90
    flang/test/Semantics/selecttype03.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 90d8d1d3d9555..b84afe581a5a2 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -175,8 +175,7 @@ bool IsAssumedLengthCharacter(const Symbol &);
 bool IsExternal(const Symbol &);
 bool IsModuleProcedure(const Symbol &);
 // Is the symbol modifiable in this scope
-std::optional<parser::MessageFixedText> WhyNotModifiable(
-    const Symbol &, const Scope &);
+std::optional<parser::Message> WhyNotModifiable(const Symbol &, const Scope &);
 std::optional<parser::Message> WhyNotModifiable(SourceName, const SomeExpr &,
     const Scope &, bool vectorSubscriptIsOk = false);
 const Symbol *IsExternalInPureContext(const Symbol &, const Scope &);

diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 47a860874ae32..d06a79b834f3b 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1901,10 +1901,12 @@ void OmpStructureChecker::CheckIntentInPointerAndDefinable(
         }
         if (auto msg{
                 WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
-          context_.Say(GetContext().clauseSource,
-              "Variable '%s' on the %s clause is not definable"_err_en_US,
-              symbol->name(),
-              parser::ToUpperCaseLetters(getClauseName(clause).str()));
+          context_
+              .Say(GetContext().clauseSource,
+                  "Variable '%s' on the %s clause is not definable"_err_en_US,
+                  symbol->name(),
+                  parser::ToUpperCaseLetters(getClauseName(clause).str()))
+              .Attach(std::move(*msg));
         }
       }
     }
@@ -2473,7 +2475,7 @@ void OmpStructureChecker::CheckDefinableObjects(
               "Variable '%s' on the %s clause is not definable"_err_en_US,
               symbol->name(),
               parser::ToUpperCaseLetters(getClauseName(clause).str()))
-          .Attach(source, std::move(*msg), symbol->name());
+          .Attach(std::move(*msg));
     }
   }
 }

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 9f7338195c09e..15cc77328b34e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -523,7 +523,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
   void SayAlreadyDeclared(const SourceName &, Symbol &);
   void SayAlreadyDeclared(const SourceName &, const SourceName &);
   void SayWithReason(
-      const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&);
+      const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
   void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
   void SayLocalMustBeVariable(const parser::Name &, Symbol &);
   void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
@@ -2056,16 +2056,20 @@ void ScopeHandler::SayAlreadyDeclared(
 }
 
 void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
-    MessageFixedText &&msg1, MessageFixedText &&msg2) {
-  Say2(name, std::move(msg1), symbol, std::move(msg2));
+    MessageFixedText &&msg1, Message &&msg2) {
+  Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));
   context().SetError(symbol, msg1.isFatal());
 }
 
 void ScopeHandler::SayWithDecl(
     const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
-  SayWithReason(name, symbol, std::move(msg),
-      symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US
-                                          : "Declaration of '%s'"_en_US);
+  Say(name, std::move(msg), symbol.name())
+      .Attach(Message{name.source,
+          symbol.test(Symbol::Flag::Implicit)
+              ? "Implicit declaration of '%s'"_en_US
+              : "Declaration of '%s'"_en_US,
+          name.source});
+  context().SetError(symbol, msg.isFatal());
 }
 
 void ScopeHandler::SayLocalMustBeVariable(
@@ -5379,8 +5383,7 @@ bool DeclarationVisitor::PassesLocalityChecks(
         "Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
     return false;
   }
-  if (std::optional<MessageFixedText> msg{
-          WhyNotModifiable(symbol, currScope())}) {
+  if (std::optional<Message> msg{WhyNotModifiable(symbol, currScope())}) {
     SayWithReason(name, symbol,
         "'%s' may not appear in a locality-spec because it is not "
         "definable"_err_en_US,

diff  --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 9bad51dd4371b..e0cb86ed8160b 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -773,25 +773,42 @@ bool InProtectedContext(const Symbol &symbol, const Scope &currentScope) {
 // C1101 and C1158
 // Modifiability checks on the leftmost symbol ("base object")
 // of a data-ref
-std::optional<parser::MessageFixedText> WhyNotModifiableFirst(
-    const Symbol &symbol, const Scope &scope) {
-  if (symbol.has<AssocEntityDetails>()) {
-    return "'%s' is construct associated with an expression"_en_US;
+static std::optional<parser::Message> WhyNotModifiableFirst(
+    parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
+  if (const auto *assoc{symbol.detailsIf<AssocEntityDetails>()}) {
+    if (assoc->rank().has_value()) {
+      return std::nullopt; // SELECT RANK always modifiable variable
+    } else if (IsVariable(assoc->expr())) {
+      if (evaluate::HasVectorSubscript(assoc->expr().value())) {
+        return parser::Message{
+            at, "Construct association has a vector subscript"_en_US};
+      } else {
+        return WhyNotModifiable(at, *assoc->expr(), scope);
+      }
+    } else {
+      return parser::Message{at,
+          "'%s' is construct associated with an expression"_en_US,
+          symbol.name()};
+    }
   } else if (IsExternalInPureContext(symbol, scope)) {
-    return "'%s' is externally visible and referenced in a pure"
-           " procedure"_en_US;
+    return parser::Message{at,
+        "'%s' is externally visible and referenced in a pure"
+        " procedure"_en_US,
+        symbol.name()};
   } else if (!IsVariableName(symbol)) {
-    return "'%s' is not a variable"_en_US;
+    return parser::Message{at, "'%s' is not a variable"_en_US, symbol.name()};
   } else {
     return std::nullopt;
   }
 }
 
 // Modifiability checks on the rightmost symbol of a data-ref
-std::optional<parser::MessageFixedText> WhyNotModifiableLast(
-    const Symbol &symbol, const Scope &scope) {
+static std::optional<parser::Message> WhyNotModifiableLast(
+    parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
   if (IsOrContainsEventOrLockComponent(symbol)) {
-    return "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US;
+    return parser::Message{at,
+        "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
+        symbol.name()};
   } else {
     return std::nullopt;
   }
@@ -800,27 +817,29 @@ std::optional<parser::MessageFixedText> WhyNotModifiableLast(
 // Modifiability checks on the leftmost (base) symbol of a data-ref
 // that apply only when there are no pointer components or a base
 // that is a pointer.
-std::optional<parser::MessageFixedText> WhyNotModifiableIfNoPtr(
-    const Symbol &symbol, const Scope &scope) {
+static std::optional<parser::Message> WhyNotModifiableIfNoPtr(
+    parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
   if (InProtectedContext(symbol, scope)) {
-    return "'%s' is protected in this scope"_en_US;
+    return parser::Message{
+        at, "'%s' is protected in this scope"_en_US, symbol.name()};
   } else if (IsIntentIn(symbol)) {
-    return "'%s' is an INTENT(IN) dummy argument"_en_US;
+    return parser::Message{
+        at, "'%s' is an INTENT(IN) dummy argument"_en_US, symbol.name()};
   } else {
     return std::nullopt;
   }
 }
 
 // Apply all modifiability checks to a single symbol
-std::optional<parser::MessageFixedText> WhyNotModifiable(
+std::optional<parser::Message> WhyNotModifiable(
     const Symbol &original, const Scope &scope) {
   const Symbol &symbol{GetAssociationRoot(original)};
-  if (auto first{WhyNotModifiableFirst(symbol, scope)}) {
+  if (auto first{WhyNotModifiableFirst(symbol.name(), symbol, scope)}) {
     return first;
-  } else if (auto last{WhyNotModifiableLast(symbol, scope)}) {
+  } else if (auto last{WhyNotModifiableLast(symbol.name(), symbol, scope)}) {
     return last;
   } else if (!IsPointer(symbol)) {
-    return WhyNotModifiableIfNoPtr(symbol, scope);
+    return WhyNotModifiableIfNoPtr(symbol.name(), symbol, scope);
   } else {
     return std::nullopt;
   }
@@ -834,21 +853,16 @@ std::optional<parser::Message> WhyNotModifiable(parser::CharBlock at,
       return parser::Message{at, "Variable has a vector subscript"_en_US};
     }
     const Symbol &first{GetAssociationRoot(dataRef->GetFirstSymbol())};
-    if (auto maybeWhyFirst{WhyNotModifiableFirst(first, scope)}) {
-      return parser::Message{first.name(),
-          parser::MessageFormattedText{
-              std::move(*maybeWhyFirst), first.name()}};
+    if (auto maybeWhyFirst{WhyNotModifiableFirst(at, first, scope)}) {
+      return maybeWhyFirst;
     }
     const Symbol &last{dataRef->GetLastSymbol()};
-    if (auto maybeWhyLast{WhyNotModifiableLast(last, scope)}) {
-      return parser::Message{last.name(),
-          parser::MessageFormattedText{std::move(*maybeWhyLast), last.name()}};
+    if (auto maybeWhyLast{WhyNotModifiableLast(at, last, scope)}) {
+      return maybeWhyLast;
     }
     if (!GetLastPointerSymbol(*dataRef)) {
-      if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(first, scope)}) {
-        return parser::Message{first.name(),
-            parser::MessageFormattedText{
-                std::move(*maybeWhyFirst), first.name()}};
+      if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(at, first, scope)}) {
+        return maybeWhyFirst;
       }
     }
   } else if (!evaluate::IsVariable(expr)) {

diff  --git a/flang/test/Semantics/modifiable01.f90 b/flang/test/Semantics/modifiable01.f90
index f7bfded602180..fc5b749f857a6 100644
--- a/flang/test/Semantics/modifiable01.f90
+++ b/flang/test/Semantics/modifiable01.f90
@@ -39,7 +39,7 @@ subroutine test1(dummy)
     end associate
     associate (a => arr([1])) ! vector subscript
       !CHECK: error: Input variable 'a' must be definable
-      !CHECK: 'a' is construct associated with an expression
+      !CHECK: Construct association has a vector subscript
       read(internal,*) a
     end associate
     associate (a => arr(2:1:-1))

diff  --git a/flang/test/Semantics/resolve57.f90 b/flang/test/Semantics/resolve57.f90
index 526bdc5638722..6fa698c4cfbbe 100644
--- a/flang/test/Semantics/resolve57.f90
+++ b/flang/test/Semantics/resolve57.f90
@@ -85,6 +85,13 @@ subroutine s6()
   end select
 
   select type ( a => func() )
+  type is ( point )
+    ! C1158 This is OK because 'a' is associated with a variable
+    do concurrent (i=1:5) local(a)
+    end do
+  end select
+
+  select type ( a => (func()) )
   type is ( point )
     ! C1158 This is not OK because 'a' is not associated with a variable
 !ERROR: 'a' may not appear in a locality-spec because it is not definable

diff  --git a/flang/test/Semantics/selecttype03.f90 b/flang/test/Semantics/selecttype03.f90
index 45ecf51164fe9..bfb1bd4535e51 100644
--- a/flang/test/Semantics/selecttype03.f90
+++ b/flang/test/Semantics/selecttype03.f90
@@ -29,6 +29,13 @@
 end select
 
 select type ( y => fun(1) )
+  type is (t1)
+    y%i = 1 !VDC
+  type is (t2)
+    call sub_with_in_and_inout_param(y,y) !VDC
+end select
+
+select type ( y => (fun(1)) )
   type is (t1)
     !ERROR: Left-hand side of assignment is not modifiable
     y%i = 1 !VDC


        


More information about the flang-commits mailing list