[flang] Fix pointer definition semantic checking via refactoring

[klausler]

Summary

The infrastructure in semantics that is used to check that the
left-hand sides of normal assignment statements are really definable
variables was not being used to check whether the LHSs of pointer assignments
are modifiable, and so most cases of unmodifiable pointers are left
undiagnosed. Rework the semantics checking for pointer assignments,
NULLIFY statements, pointer dummy arguments, &c. so that cases of
unmodifiable pointers are properly caught. This has been done
by extracting all the various definability checking code that has
been implemented for different contexts in Fortran into one new
facility.

The new consolidated definability checking code returns messages
meant to be attached as "because: " explanations to context-dependent
errors like "left-hand side of assignment is not definable".
These new error message texts and their attached explanations
affect many existing tests, which have been updated. The testing
infrastructure was extended by another patch to properly compare
warnings and explanatory messages, which had been ignored until
recently.

[klausler]

Update error messages in two newer tests.

[PeteSteinfeld]

Things generally look good, but I'm getting failures in the tests Semantics/atomic[06,08].f90.

[klausler]

All test issues are resolved.

[klausler]

Please take another look.

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks for fixing this!

flang/docs/Parsing.md

 stream, or to contiguous ranges thereof, are used as source position
 indicators within the parser and in the parse tree.
 
 ## Messages
 
 Message texts, and snprintf-like formatting strings for constructing
 messages, are instantiated in the various components of the parser with
 C++ user defined character literals tagged with `_err_en_US`, `_warn_en_US`,
-`port_en_US`, and `_en_US` to signify severity and language; the default
-language is the dialect of English used in the United States.
+`port_en_US`, `because_en_US`, `todo_en_US`, and `_en_US` to signify severity
+and language.
+The default language is the dialect of English used in the United States.
 
 All "fatal" errors that do not immediately abort compilation but do
 prevent the generation of binary and module files are `_err_en_US`.
 Warnings about detected flaws in the program that probably indicate
 problems worth attention are `_warn_en_US`.
 Non-conforming extensions, legacy features, and obsolescent or deleted
 features will raise `_port_en_US` messages when those are enabled.
-Other messages have a simple `_en_US` suffix, including all messages
-that are explanatory attachments.
+Messages that are explanatory attachments to others are `_because_en_US`.
+Messages signifying an incomplete compiler feature are `_todo_en_US`.
+Other messages have a simple `_en_US` suffix.
 
 As described above, messages are associated with
 source code positions by means of provenance values.
 
 ## The Parse Tree
 
 Each of the ca. 450 numbered requirement productions in the standard
 Fortran language grammar, as well as the productions implied by legacy

flang/include/flang/Parser/message.h

 #include <list>
 #include <optional>
 #include <string>
 #include <utility>
 #include <variant>
 
 namespace Fortran::parser {
 
-// Use "..."_err_en_US, "..."_warn_en_US, "..."_port_en_US, and "..."_en_US
-// string literals to define the static text and fatality of a message.
-//
+// Use "..."_err_en_US, "..."_warn_en_US, "..."_port_en_US, "..."_because_en_US,
+// "..."_todo_en_US, and "..."_en_US string literals to define the static text
+// and severity of a message or attachment.
 enum class Severity {
   Error, // fatal error that prevents code and module file generation
   Warning, // likely problem
   Portability, // nonstandard or obsolete features
   Because, // for AttachTo(), explanatory attachment to support another message
   Context, // (internal): attachment from SetContext()
   Todo, // a feature that's not yet implemented, a fatal error
   None // everything else, common for attachments with source locations

 constexpr MessageFixedText operator""_warn_en_US(
     const char str[], std::size_t n) {
   return MessageFixedText{str, n, Severity::Warning};
 }
 constexpr MessageFixedText operator""_port_en_US(
     const char str[], std::size_t n) {
   return MessageFixedText{str, n, Severity::Portability};
 }
+constexpr MessageFixedText operator""_because_en_US(
+    const char str[], std::size_t n) {
+  return MessageFixedText{str, n, Severity::Because};
+}
 constexpr MessageFixedText operator""_todo_en_US(
     const char str[], std::size_t n) {
   return MessageFixedText{str, n, Severity::Todo};
 }
 constexpr MessageFixedText operator""_en_US(const char str[], std::size_t n) {
   return MessageFixedText{str, n, Severity::None};
 }
 } // namespace literals
public:
   Message *Say(std::optional<CharBlock> at, A &&...args) {
     return Say(at.value_or(at_), std::forward<A>(args)...);
   }
 
   template <typename... A> Message *Say(A &&...args) {
     return Say(at_, std::forward<A>(args)...);
   }
 
+  Message *Say(Message &&msg) {
+    if (messages_ != nullptr) {
+      if (contextMessage_) {
+        msg.SetContext(contextMessage_.get());
+      }
+      return &messages_->Say(std::move(msg));
+    } else {
+      return nullptr;
+    }
+  }
+
 private:
   CharBlock at_;
   Messages *messages_{nullptr};
   Message::Reference contextMessage_;
 };
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_MESSAGE_H_

flang/include/flang/Semantics/tools.h

 bool IsInBlankCommon(const Symbol &);
 inline bool IsAssumedSizeArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedSize();
 }
 bool IsAssumedLengthCharacter(const Symbol &);
 bool IsExternal(const Symbol &);
 bool IsModuleProcedure(const Symbol &);
-// Is the symbol modifiable in this 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 &);
 bool HasCoarray(const parser::Expr &);
 bool IsAssumedType(const Symbol &);
 bool IsPolymorphic(const Symbol &);
 bool IsPolymorphicAllocatable(const Symbol &);
 // Return an error if component symbol is not accessible from scope (7.5.4.8(2))
 std::optional<parser::MessageFormattedText> CheckAccessibleComponent(
     const semantics::Scope &, const Symbol &);
 

 // When a subprogram defined in a submodule defines a separate module
 // procedure whose interface is defined in an ancestor (sub)module,
 // returns a pointer to that interface, else null.
 const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
 
 // Determines whether an object might be visible outside a
 // pure function (C1594); returns a non-null Symbol pointer for
 // diagnostic purposes if so.
-const Symbol *FindExternallyVisibleObject(const Symbol &, const Scope &);
+const Symbol *FindExternallyVisibleObject(
+    const Symbol &, const Scope &, bool isPointerDefinition);
 
 template <typename A>
 const Symbol *FindExternallyVisibleObject(const A &, const Scope &) {
   return nullptr; // default base case
 }
 
 template <typename T>
 const Symbol *FindExternallyVisibleObject(
     const evaluate::Designator<T> &designator, const Scope &scope) {
   if (const Symbol * symbol{designator.GetBaseObject().symbol()}) {
-    return FindExternallyVisibleObject(*symbol, scope);
+    return FindExternallyVisibleObject(*symbol, scope, false);
   } else if (std::holds_alternative<evaluate::CoarrayRef>(designator.u)) {
     // Coindexed values are visible even if their image-local objects are not.
     return designator.GetBaseObject().symbol();
   } else {
     return nullptr;
   }
 }
 

flang/lib/Semantics/CMakeLists.txt

add_flang_library(FortranSemantics
   check-omp-structure.cpp
   check-purity.cpp
   check-return.cpp
   check-select-rank.cpp
   check-select-type.cpp
   check-stop.cpp
   compute-offsets.cpp
   data-to-inits.cpp
+  definable.cpp
   expression.cpp
   mod-file.cpp
   pointer-assignment.cpp
   program-tree.cpp
   resolve-labels.cpp
   resolve-directives.cpp
   resolve-names-utils.cpp
   resolve-names.cpp

flang/lib/Semantics/assignment.h

 } // namespace Fortran::parser
 
 namespace Fortran::semantics {
 
 class AssignmentContext;
 class Scope;
 class Symbol;
 
-// Applies checks from C1594(1-2) on definitions in pure subprograms
-bool CheckDefinabilityInPureScope(parser::ContextualMessages &, const Symbol &,
-    const Scope &context, const Scope &pure);
 // Applies checks from C1594(5-6) on copying pointers in pure subprograms
 bool CheckCopyabilityInPureScope(parser::ContextualMessages &,
     const evaluate::Expr<evaluate::SomeType> &, const Scope &);
 
 class AssignmentChecker : public virtual BaseChecker {
 public:
   explicit AssignmentChecker(SemanticsContext &);
   ~AssignmentChecker();

flang/lib/Semantics/assignment.cpp

 //===-- lib/Semantics/assignment.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "assignment.h"
+#include "definable.h"
 #include "pointer-assignment.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/restorer.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/message.h"
public:
 
   template <typename A> void PushWhereContext(const A &);
   void PopWhereContext();
   void Analyze(const parser::AssignmentStmt &);
   void Analyze(const parser::PointerAssignmentStmt &);
   void Analyze(const parser::ConcurrentControl &);
 
 private:
-  bool CheckForPureContext(const SomeExpr &lhs, const SomeExpr &rhs,
-      parser::CharBlock rhsSource, bool isPointerAssignment);
+  bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource,
+      bool isPointerAssignment);
   void CheckShape(parser::CharBlock, const SomeExpr *);
   template <typename... A>
   parser::Message *Say(parser::CharBlock at, A &&...args) {
     return &context_.Say(at, std::forward<A>(args)...);
   }
   evaluate::FoldingContext &foldingContext() {
     return context_.foldingContext();
   }
 
   SemanticsContext &context_;
   int whereDepth_{0}; // number of WHEREs currently nested in
   // shape of masks in LHS of assignments in current WHERE:
   std::vector<std::optional<std::int64_t>> whereExtents_;
 };
 
 void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
     const SomeExpr &lhs{assignment->lhs};
     const SomeExpr &rhs{assignment->rhs};
     auto lhsLoc{std::get<parser::Variable>(stmt.t).GetSource()};
-    auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
-    if (CheckForPureContext(lhs, rhs, rhsLoc, false)) {
-      const Scope &scope{context_.FindScope(lhsLoc)};
-      if (auto whyNot{WhyNotModifiable(lhsLoc, lhs, scope, true)}) {
-        if (auto *msg{Say(lhsLoc,
-                "Left-hand side of assignment is not modifiable"_err_en_US)}) {
-          msg->Attach(*whyNot);
-        }
+    if (auto whyNot{WhyNotDefinable(lhsLoc, scope,
+            DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, lhs)}) {
+              "Left-hand side of assignment is not definable"_err_en_US)}) {
+        msg->Attach(std::move(*whyNot));
       }
     }
+    auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
+    CheckForPureContext(rhs, rhsLoc, false);
     if (whereDepth_ > 0) {
       CheckShape(lhsLoc, &lhs);
     }
   }
 }
 
 void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
   CHECK(whereDepth_ == 0);
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
-    const SomeExpr &lhs{assignment->lhs};
     const SomeExpr &rhs{assignment->rhs};
-    CheckForPureContext(lhs, rhs, std::get<parser::Expr>(stmt.t).source, true);
-    auto restorer{
-        foldingContext().messages().SetLocation(context_.location().value())};
-    CheckPointerAssignment(foldingContext(), *assignment);
-  }
-}
-
-// C1594 checks
-static bool IsPointerDummyOfPureFunction(const Symbol &x) {
-  return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
-      x.owner().symbol() && IsFunction(*x.owner().symbol());
-}
-
-static const char *WhyBaseObjectIsSuspicious(
-    const Symbol &x, const Scope &scope) {
-  // See C1594, first paragraph.  These conditions enable checks on both
-  // left-hand and right-hand sides in various circumstances.
-  if (IsHostAssociatedIntoSubprogram(x, scope)) {
-    return "host-associated";
-  } else if (IsUseAssociated(x, scope)) {
-    return "USE-associated";
-  } else if (IsPointerDummyOfPureFunction(x)) {
-    return "a POINTER dummy argument of a pure function";
-  } else if (IsIntentIn(x)) {
-    return "an INTENT(IN) dummy argument";
-  } else if (FindCommonBlockContaining(x)) {
-    return "in a COMMON block";
-  } else {
-    return nullptr;
-  }
+    CheckForPureContext(rhs, std::get<parser::Expr>(stmt.t).source, true);
+    parser::CharBlock at{context_.location().value()};
+    auto restorer{foldingContext().messages().SetLocation(at)};
+    const Scope &scope{context_.FindScope(at)};
+    CheckPointerAssignment(foldingContext(), *assignment, scope);
   }
-
-// Checks C1594(1,2); false if check fails
-bool CheckDefinabilityInPureScope(parser::ContextualMessages &messages,
-    const Symbol &lhs, const Scope &context, const Scope &pure) {
-  if (pure.symbol()) {
-    if (const char *why{WhyBaseObjectIsSuspicious(lhs, context)}) {
-      evaluate::SayWithDeclaration(messages, lhs,
-          "Pure subprogram '%s' may not define '%s' because it is %s"_err_en_US,
-          pure.symbol()->name(), lhs.name(), why);
-      return false;
-    }
-  }
-  return true;
 }
 
 static std::optional<std::string> GetPointerComponentDesignatorName(
     const SomeExpr &expr) {
   if (const auto *derived{
           evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) {
     UltimateComponentIterator ultimates{*derived};
     if (auto pointer{
             std::find_if(ultimates.begin(), ultimates.end(), IsPointer)}) {
       return pointer.BuildResultDesignatorName();
     }
   }
   return std::nullopt;
 }
 
 // Checks C1594(5,6); false if check fails
 bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
     const SomeExpr &expr, const Scope &scope) {
   if (const Symbol * base{GetFirstSymbol(expr)}) {
-    if (const char *why{WhyBaseObjectIsSuspicious(*base, scope)}) {
+    if (const char *why{
+            WhyBaseObjectIsSuspicious(base->GetUltimate(), scope)}) {
       if (auto pointer{GetPointerComponentDesignatorName(expr)}) {
         evaluate::SayWithDeclaration(messages, *base,
             "A pure subprogram may not copy the value of '%s' because it is %s"
             " and has the POINTER component '%s'"_err_en_US,
             base->name(), why, *pointer);
         return false;
       }
     }
   }
   return true;
 }
 
-bool AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
-    const SomeExpr &rhs, parser::CharBlock source, bool isPointerAssignment) {
-  const Scope &scope{context_.FindScope(source)};
-  if (const Scope * pure{FindPureProcedureContaining(scope)}) {
-    parser::ContextualMessages messages{
-        context_.location().value(), &context_.messages()};
-    if (evaluate::ExtractCoarrayRef(lhs)) {
-      messages.Say(
-          "A pure subprogram may not define a coindexed object"_err_en_US);
-    } else if (const Symbol * base{GetFirstSymbol(lhs)}) {
-      if (const auto *assoc{base->detailsIf<AssocEntityDetails>()}) {
-        auto dataRef{ExtractDataRef(assoc->expr(), true)};
-        // ASSOCIATE(a=>x) -- check x, not a, for "a=..."
-        base = dataRef ? &dataRef->GetFirstSymbol() : nullptr;
-      }
-      if (base &&
-          !CheckDefinabilityInPureScope(messages, *base, scope, *pure)) {
-        return false;
-      }
-    }
-    if (isPointerAssignment) {
-      if (const Symbol * base{GetFirstSymbol(rhs)}) {
-        if (const char *why{
-                WhyBaseObjectIsSuspicious(*base, scope)}) { // C1594(3)
-          evaluate::SayWithDeclaration(messages, *base,
-              "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
-              base->name(), why);
-          return false;
-        }
-      }
-    } else if (auto type{evaluate::DynamicType::From(lhs)}) {
-      // C1596 checks for polymorphic deallocation in a pure subprogram
-      // due to automatic reallocation on assignment
-      if (type->IsPolymorphic()) {
-        context_.Say(
-            "Deallocation of polymorphic object is not permitted in a pure subprogram"_err_en_US);
-        return false;
-      }
-      if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
-        if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
-                *derived)}) {
-          evaluate::SayWithDeclaration(messages, *bad,
-              "Deallocation of polymorphic non-coarray component '%s' is not permitted in a pure subprogram"_err_en_US,
-              bad.BuildResultDesignatorName());
-          return false;
-        } else {
-          return CheckCopyabilityInPureScope(messages, rhs, scope);
-        }
-      }
-    }
-  }
+bool AssignmentContext::CheckForPureContext(const SomeExpr &rhs,
+    parser::CharBlock rhsSource, bool isPointerAssignment) {
+  const Scope &scope{context_.FindScope(rhsSource)};
+  if (!FindPureProcedureContaining(scope)) {
+    return true;
+  }
+      if (const char *why{WhyBaseObjectIsSuspicious(
+              base->GetUltimate(), scope)}) { // C1594(3)
   return true;
 }
 
 // 10.2.3.1(2) The masks and LHS of assignments must be arrays of the same shape
 void AssignmentContext::CheckShape(parser::CharBlock at, const SomeExpr *expr) {
   if (auto shape{evaluate::GetShape(foldingContext(), expr)}) {
     std::size_t size{shape->size()};
     if (size == 0) {

flang/lib/Semantics/check-call.cpp

 //===-- lib/Semantics/check-call.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-call.h"
+#include "definable.h"
 #include "pointer-assignment.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/shape.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/message.h"
 #include "flang/Semantics/scope.h"
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   // Definability
   const char *reason{nullptr};
   if (dummy.intent == common::Intent::Out) {
     reason = "INTENT(OUT)";
   } else if (dummy.intent == common::Intent::InOut) {
     reason = "INTENT(IN OUT)";
   }
   if (reason && scope) {
-    bool vectorSubscriptIsOk{isElemental || dummyIsValue}; // 15.5.2.4(21)
-    if (auto why{WhyNotModifiable(
-            messages.at(), actual, *scope, vectorSubscriptIsOk)}) {
+    DefinabilityFlags flags;
+    if (isElemental || dummyIsValue) { // 15.5.2.4(21)
+      flags.set(DefinabilityFlag::VectorSubscriptIsOk);
+    }
+    if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
       if (auto *msg{messages.Say(
-              "Actual argument associated with %s %s must be definable"_err_en_US,
+              "Actual argument associated with %s %s is not definable"_err_en_US,
               reason, dummyName)}) {
-        msg->Attach(*why);
+        msg->Attach(std::move(*whyNot));
       }
     }
   }
 
   // Cases when temporaries might be needed but must not be permitted.
   bool actualIsContiguous{IsSimplyContiguous(actual, context)};
   bool dummyIsAssumedShape{dummy.type.attrs().test(
       characteristics::TypeAndShape::Attr::AssumedShape)};
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (dummyIsPointer) {
     if (dummyIsContiguous && !actualIsContiguous) {
       messages.Say(
           "Actual argument associated with CONTIGUOUS POINTER %s must be simply contiguous"_err_en_US,
           dummyName);
     }
     if (!actualIsPointer) {
       if (dummy.intent == common::Intent::In) {
+        if (scope) {
           semantics::CheckPointerAssignment(
-            context, parser::CharBlock{}, dummyName, dummy, actual);
+              context, messages.at(), dummyName, dummy, actual, *scope);
+        }
       } else {
         messages.Say(
             "Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
             dummyName);
       }
     }
   }
 

flang/lib/Semantics/check-declarations.cpp

 void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
   if (IsPointer(symbol) && !context_.HasError(symbol) &&
       !scopeIsUninstantiatedPDT_) {
     if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
       if (object->init()) { // C764, C765; C808
         if (auto designator{evaluate::AsGenericExpr(symbol)}) {
           auto restorer{messages_.SetLocation(symbol.name())};
           context_.set_location(symbol.name());
-          CheckInitialTarget(foldingContext_, *designator, *object->init());
+          CheckInitialTarget(
+              foldingContext_, *designator, *object->init(), DEREF(scope_));
         }
       }
     } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
       if (proc->init() && *proc->init()) {
         // C1519 - must be nonelemental external or module procedure,
         // or an unrestricted specific intrinsic function.
         const Symbol &ultimate{(*proc->init())->GetUltimate()};
         if (ultimate.attrs().test(Attr::INTRINSIC)) {

flang/lib/Semantics/check-io.cpp

 //===-- lib/Semantics/check-io.cpp ----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-io.h"
+#include "definable.h"
 #include "flang/Common/format.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/tools.h"
 #include <unordered_map>
 
 namespace Fortran::semantics {

 }
 
 template <typename A>
 void IoChecker::CheckForDefinableVariable(
     const A &variable, const std::string &s) const {
   if (const auto *var{parser::Unwrap<parser::Variable>(variable)}) {
     if (auto expr{AnalyzeExpr(context_, *var)}) {
       auto at{var->GetSource()};
-      if (auto whyNot{WhyNotModifiable(at, *expr, context_.FindScope(at),
-              true /*vectorSubscriptIsOk*/)}) {
+      if (auto whyNot{WhyNotDefinable(at, context_.FindScope(at),
+              DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk},
+              *expr)}) {
         const Symbol *base{GetFirstSymbol(*expr)};
         context_
-            .Say(at, "%s variable '%s' must be definable"_err_en_US, s,
+            .Say(at, "%s variable '%s' is not definable"_err_en_US, s,
                 (base ? base->name() : at).ToString())
             .Attach(std::move(*whyNot));
       }
     }
   }
 }
 
 void IoChecker::CheckForPureSubprogram() const { // C1597

flang/lib/Semantics/check-nullify.cpp

 //===-- lib/Semantics/check-nullify.cpp -----------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-nullify.h"
-#include "assignment.h"
+#include "definable.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/tools.h"
 
 namespace Fortran::semantics {
 
 void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
   CHECK(context_.location());
   const Scope &scope{context_.FindScope(*context_.location())};
-  const Scope *pure{FindPureProcedureContaining(scope)};
-  parser::ContextualMessages messages{
-      *context_.location(), &context_.messages()};
   for (const parser::PointerObject &pointerObject : nullifyStmt.v) {
     common::visit(
         common::visitors{
             [&](const parser::Name &name) {
-              const Symbol *symbol{name.symbol};
-              if (context_.HasError(symbol)) {
-                // already reported an error
-              } else if (!IsVariableName(*symbol) &&
-                  !IsProcedurePointer(*symbol)) {
-                messages.Say(name.source,
-                    "name in NULLIFY statement must be a variable or procedure pointer"_err_en_US);
-              } else if (!IsPointer(*symbol)) { // C951
-                messages.Say(name.source,
-                    "name in NULLIFY statement must have the POINTER attribute"_err_en_US);
-              } else if (pure) {
-                CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
+              if (name.symbol) {
+                if (auto whyNot{WhyNotDefinable(name.source, scope,
+                        DefinabilityFlags{DefinabilityFlag::PointerDefinition},
+                        *name.symbol)}) {
+                  context_.messages()
+                      .Say(name.source,
+                          "'%s' may not appear in NULLIFY"_err_en_US,
+                          name.source)
+                      .Attach(std::move(*whyNot));
+                }
               }
             },
             [&](const parser::StructureComponent &structureComponent) {
+              const auto &component{structureComponent.component};
+              SourceName at{component.source};
               if (const auto *checkedExpr{GetExpr(context_, pointerObject)}) {
-                if (!IsPointer(*structureComponent.component.symbol)) { // C951
-                  messages.Say(structureComponent.component.source,
-                      "component in NULLIFY statement must have the POINTER attribute"_err_en_US);
-                } else if (pure) {
-                  if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
-                    CheckDefinabilityInPureScope(
-                        messages, *symbol, scope, *pure);
-                  }
+                if (auto whyNot{WhyNotDefinable(at, scope,
+                        DefinabilityFlags{DefinabilityFlag::PointerDefinition},
+                        *checkedExpr)}) {
+                  context_.messages()
+                      .Say(at, "'%s' may not appear in NULLIFY"_err_en_US, at)
+                      .Attach(std::move(*whyNot));
                 }
               }
             },
         },
         pointerObject.u);
   }
   // From 9.7.3.1(1)
   //   A pointer-object shall not depend on the value,
   //   bounds, or association status of another pointer-
   //   object in the same NULLIFY statement.
   // This restriction is the programmer's responsibility.
   // Some dependencies can be found compile time or at
   // runtime, but for now we choose to skip such checks.
 }
 } // namespace Fortran::semantics

flang/lib/Semantics/check-omp-structure.cpp

 //===-- lib/Semantics/check-omp-structure.cpp -----------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-omp-structure.h"
+#include "definable.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/tools.h"
 #include <algorithm>
 
 namespace Fortran::semantics {
 
 // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
 #define CHECK_SIMPLE_CLAUSE(X, Y) \
if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
       if (const auto *symbol{name->symbol}) {
         if (IsPointer(symbol->GetUltimate()) &&
             IsIntentIn(symbol->GetUltimate())) {
           context_.Say(GetContext().clauseSource,
               "Pointer '%s' with the INTENT(IN) attribute may not appear "
               "in a %s clause"_err_en_US,
               symbol->name(),
               parser::ToUpperCaseLetters(getClauseName(clause).str()));
-        }
-        if (auto msg{
-                WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
+        } else if (auto msg{WhyNotDefinable(name->source,
+                       context_.FindScope(name->source), DefinabilityFlags{},
+                       *symbol)}) {
           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));
         }
       }
void OmpStructureChecker::GetSymbolsInObjectList(
   }
 }
 
 void OmpStructureChecker::CheckDefinableObjects(
     SymbolSourceMap &symbols, const llvm::omp::Clause clause) {
   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
     const auto *symbol{it->first};
     const auto source{it->second};
-    if (auto msg{WhyNotModifiable(*symbol, context_.FindScope(source))}) {
+    if (auto msg{WhyNotDefinable(source, context_.FindScope(source),
+            DefinabilityFlags{}, *symbol)}) {
       context_
           .Say(source,
               "Variable '%s' on the %s clause is not definable"_err_en_US,
               symbol->name(),
               parser::ToUpperCaseLetters(getClauseName(clause).str()))
           .Attach(std::move(*msg));
     }
   }

flang/lib/Semantics/data-to-inits.cpp

private:
   bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator);
   // If the returned flag is true, emit a warning about CHARACTER misusage.
   std::optional<std::pair<SomeExpr, bool>> ConvertElement(
       const SomeExpr &, const evaluate::DynamicType &);
 
   DataInitializations &inits_;
   evaluate::ExpressionAnalyzer &exprAnalyzer_;
   ValueListIterator<DSV> values_;
+  const Scope *scope_{nullptr};
 };
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(
     const parser::DataStmtObject &object) {
   return common::visit(
       common::visitors{
           [&](const common::Indirection<parser::Variable> &var) {
             return Scan(var.value());
           },
           [&](const parser::DataImpliedDo &ido) { return Scan(ido); },
       },
       object.u);
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(const parser::Variable &var) {
   if (const auto *expr{GetExpr(exprAnalyzer_.context(), var)}) {
-    exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource());
+    parser::CharBlock at{var.GetSource()};
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
+    scope_ = &exprAnalyzer_.context().FindScope(at);
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;
 }
 
 template <typename DSV>
 bool DataInitializationCompiler<DSV>::Scan(
     const parser::Designator &designator) {
   if (auto expr{exprAnalyzer_.Analyze(designator)}) {
-    exprAnalyzer_.GetFoldingContext().messages().SetLocation(
-        parser::FindSourceLocation(designator));
+    parser::CharBlock at{parser::FindSourceLocation(designator)};
+    exprAnalyzer_.GetFoldingContext().messages().SetLocation(at);
+    scope_ = &exprAnalyzer_.context().FindScope(at);
     if (InitDesignator(*expr)) {
       return true;
     }
   }
   return false;
 }
 
 template <typename DSV>
if (!expr) {
     if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
         symbol.size()) {
       OutOfRangeError();
     } else if (evaluate::IsNullPointer(*expr)) {
       // nothing to do; rely on zero initialization
       return true;
     } else if (isProcPointer) {
       if (evaluate::IsProcedure(*expr)) {
-        if (CheckPointerAssignment(context, designator, *expr)) {
+        if (CheckPointerAssignment(context, designator, *expr, DEREF(scope_))) {
           if (lastSymbol->has<ProcEntityDetails>()) {
             GetImage().AddPointer(offsetSymbol.offset(), *expr);
             return true;
           } else {
             evaluate::AttachDeclaration(
                 exprAnalyzer_.context().Say(
                     "DATA statement initialization of procedure pointer '%s' declared using a POINTER statement and an INTERFACE instead of a PROCEDURE statement"_todo_en_US,
                     DescribeElement()),
                 *lastSymbol);
           }
         }
       } else {
         exprAnalyzer_.Say(
             "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
             expr->AsFortran(), DescribeElement());
       }
     } else if (evaluate::IsProcedure(*expr)) {
       exprAnalyzer_.Say(
           "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
           expr->AsFortran(), DescribeElement());
-    } else if (CheckInitialTarget(context, designator, *expr)) {
+    } else if (CheckInitialTarget(context, designator, *expr, DEREF(scope_))) {
       GetImage().AddPointer(offsetSymbol.offset(), *expr);
       return true;
     }
   } else if (evaluate::IsNullPointer(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
         DescribeElement());
   } else if (evaluate::IsProcedure(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,

flang/lib/Semantics/definable.h

+//===-- lib/Semantics/definable.h -------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_DEFINABLE_H_
+#define FORTRAN_SEMANTICS_DEFINABLE_H_
+
+// Utilities for checking the definability of variables and pointers in context,
+// including checks for attempted definitions in PURE subprograms.
+// Fortran 2018 C1101, C1158, C1594, &c.
+
+#include "flang/Common/enum-set.h"
+#include "flang/Common/idioms.h"
+#include "flang/Evaluate/expression.h"
+#include "flang/Parser/char-block.h"
+#include "flang/Parser/message.h"
+#include <optional>
+
+namespace Fortran::semantics {
+
+class Symbol;
+class Scope;
+
+ENUM_CLASS(DefinabilityFlag,
+    VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment)
+    PointerDefinition) // a pointer is being defined, not its target
+
+using DefinabilityFlags =
+    common::EnumSet<DefinabilityFlag, DefinabilityFlag_enumSize>;
+
+// Tests a symbol or LHS variable or pointer for definability in a given scope.
+// When the entity is not definable, returns a "because:" Message suitable for
+// attachment to an error message to explain why the entity cannot be defined.
+// When the entity can be defined in that context, returns std::nullopt.
+std::optional<parser::Message> WhyNotDefinable(
+    parser::CharBlock, const Scope &, DefinabilityFlags, const Symbol &);
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock, const Scope &,
+    DefinabilityFlags, const evaluate::Expr<evaluate::SomeType> &);
+
+// If a symbol would not be definable in a pure scope, or not be usable as the
+// target of a pointer assignment in a pure scope, return a constant string
+// describing why.
+const char *WhyBaseObjectIsSuspicious(const Symbol &, const Scope &);
+
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_DEFINABLE_H_

flang/lib/Semantics/definable.cpp

+//===-- lib/Semantics/definable.cpp ---------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "definable.h"
+#include "flang/Evaluate/tools.h"
+#include "flang/Semantics/tools.h"
+
+using namespace Fortran::parser::literals;
+
+namespace Fortran::semantics {
+
+template <typename... A>
+static parser::Message BlameSymbol(parser::CharBlock at,
+    const parser::MessageFixedText &text, const Symbol &original, A &&...x) {
+  parser::Message message{at, text, original.name(), std::forward<A>(x)...};
+  message.set_severity(parser::Severity::Because);
+  evaluate::AttachDeclaration(message, original);
+  return message;
+}
+
+static bool IsPointerDummyOfPureFunction(const Symbol &x) {
+  return IsPointerDummy(x) && FindPureProcedureContaining(x.owner()) &&
+      x.owner().symbol() && IsFunction(*x.owner().symbol());
+}
+
+// See C1594, first paragraph.  These conditions enable checks on both
+// left-hand and right-hand sides in various circumstances.
+const char *WhyBaseObjectIsSuspicious(const Symbol &x, const Scope &scope) {
+  if (IsHostAssociatedIntoSubprogram(x, scope)) {
+    return "host-associated";
+  } else if (IsUseAssociated(x, scope)) {
+    return "USE-associated";
+  } else if (IsPointerDummyOfPureFunction(x)) {
+    return "a POINTER dummy argument of a pure function";
+  } else if (IsIntentIn(x)) {
+    return "an INTENT(IN) dummy argument";
+  } else if (FindCommonBlockContaining(x)) {
+    return "in a COMMON block";
+  } else {
+    return nullptr;
+  }
+}
+
+// Checks C1594(1,2); false if check fails
+static std::optional<parser::Message> CheckDefinabilityInPureScope(
+    SourceName at, const Symbol &original, const Symbol &ultimate,
+    const Scope &context, const Scope &pure) {
+  if (pure.symbol()) {
+    if (const char *why{WhyBaseObjectIsSuspicious(ultimate, context)}) {
+      return BlameSymbol(at,
+          "'%s' may not be defined in pure subprogram '%s' because it is %s"_en_US,
+          original, pure.symbol()->name(), why);
+    }
+  }
+  return std::nullopt;
+}
+
+// When a DataRef contains pointers, gets the rightmost one (unless it is
+// the entity being defined, in which case the last pointer above it);
+// otherwise, returns the leftmost symbol.  The resulting symbol is the
+// relevant base object for definabiliy checking.  Examples:
+//   ptr1%ptr2        => ...     -> ptr1
+//   nonptr%ptr       => ...     -> nonptr
+//   nonptr%ptr       =  ...     -> ptr
+//   ptr1%ptr2        =  ...     -> ptr2
+//   ptr1%ptr2%nonptr =  ...     -> ptr2
+//   nonptr1%nonptr2  =  ...     -> nonptr1
+static const Symbol &GetRelevantSymbol(
+    const evaluate::DataRef &dataRef, bool isPointerDefinition) {
+  if (isPointerDefinition) {
+    if (const auto *component{std::get_if<evaluate::Component>(&dataRef.u)}) {
+      if (IsPointer(component->GetLastSymbol())) {
+        return GetRelevantSymbol(component->base(), false);
+      }
+    }
+  }
+  if (const Symbol * lastPointer{GetLastPointerSymbol(dataRef)}) {
+    return *lastPointer;
+  } else {
+    return dataRef.GetFirstSymbol();
+  }
+}
+
+// Check the leftmost (or only) symbol from a data-ref or expression.
+static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+  const Symbol &ultimate{original.GetUltimate()};
+  bool isPointerDefinition{flags.test(DefinabilityFlag::PointerDefinition)};
+  bool isTargetDefinition{!isPointerDefinition && IsPointer(ultimate)};
+  if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()}) {
+    if (association->rank().has_value()) {
+      return std::nullopt; // SELECT RANK always modifiable variable
+    } else if (!IsVariable(association->expr())) {
+      return BlameSymbol(at,
+          "'%s' is construct associated with an expression"_en_US, original);
+    } else if (evaluate::HasVectorSubscript(association->expr().value())) {
+      return BlameSymbol(at,
+          "Construct association '%s' has a vector subscript"_en_US, original);
+    } else if (auto dataRef{evaluate::ExtractDataRef(
+                   *association->expr(), true, true)}) {
+      return WhyNotDefinableBase(
+          at, scope, flags, GetRelevantSymbol(*dataRef, isPointerDefinition));
+    }
+  }
+  if (isTargetDefinition) {
+  } else if (!isPointerDefinition && !IsVariableName(ultimate)) {
+    return BlameSymbol(at, "'%s' is not a variable"_en_US, original);
+  } else if (IsProtected(ultimate) && IsUseAssociated(original, scope)) {
+    return BlameSymbol(at, "'%s' is protected in this scope"_en_US, original);
+  } else if (IsIntentIn(ultimate)) {
+    return BlameSymbol(
+        at, "'%s' is an INTENT(IN) dummy argument"_en_US, original);
+  }
+  if (const Scope * pure{FindPureProcedureContaining(scope)}) {
+    // Additional checking for pure subprograms.
+    if (!isTargetDefinition) {
+      if (auto msg{CheckDefinabilityInPureScope(
+              at, original, ultimate, scope, *pure)}) {
+        return msg;
+      }
+    }
+    if (const Symbol *
+        visible{FindExternallyVisibleObject(
+            ultimate, *pure, isPointerDefinition)}) {
+      return BlameSymbol(at,
+          "'%s' is externally visible via '%s' and not definable in a pure subprogram"_en_US,
+          original, visible->name());
+    }
+  }
+  return std::nullopt;
+}
+
+static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+  const Symbol &ultimate{original.GetUltimate()};
+  if (flags.test(DefinabilityFlag::PointerDefinition)) {
+    if (!IsPointer(ultimate)) {
+      return BlameSymbol(at, "'%s' is not a pointer"_en_US, original);
+    }
+    return std::nullopt; // pointer assignment - skip following checks
+  }
+  if (IsOrContainsEventOrLockComponent(ultimate)) {
+    return BlameSymbol(at,
+        "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
+        original);
+  }
+  if (FindPureProcedureContaining(scope)) {
+    if (auto dyType{evaluate::DynamicType::From(ultimate)}) {
+      if (dyType->IsPolymorphic()) { // C1596
+        return BlameSymbol(at,
+            "'%s' is polymorphic in a pure subprogram"_because_en_US, original);
+      }
+      if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(dyType)}) {
+        if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent(
+                *derived)}) {
+          return BlameSymbol(at,
+              "'%s' has polymorphic non-coarray component '%s' in a pure subprogram"_because_en_US,
+              original, bad.BuildResultDesignatorName());
+        }
+      }
+    }
+  }
+  return std::nullopt;
+}
+
+// Checks a data-ref
+static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags,
+    const evaluate::DataRef &dataRef) {
+  const Symbol &base{GetRelevantSymbol(
+      dataRef, flags.test(DefinabilityFlag::PointerDefinition))};
+  if (auto whyNot{WhyNotDefinableBase(at, scope, flags, base)}) {
+    return whyNot;
+  } else {
+    return WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol());
+  }
+}
+
+// Checks a NOPASS procedure pointer component
+static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags,
+    const evaluate::Component &component) {
+  const evaluate::DataRef &dataRef{component.base()};
+  const Symbol &base{GetRelevantSymbol(dataRef, false)};
+  DefinabilityFlags baseFlags{flags};
+  baseFlags.reset(DefinabilityFlag::PointerDefinition);
+  return WhyNotDefinableBase(at, scope, baseFlags, base);
+}
+
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+  if (auto base{WhyNotDefinableBase(at, scope, flags, original)}) {
+    return base;
+  }
+  return WhyNotDefinableLast(at, scope, flags, original);
+}
+
+std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
+    const Scope &scope, DefinabilityFlags flags,
+    const evaluate::Expr<evaluate::SomeType> &expr) {
+  if (auto dataRef{evaluate::ExtractDataRef(expr, true, true)}) {
+    if (!flags.test(DefinabilityFlag::VectorSubscriptIsOk) &&
+        evaluate::HasVectorSubscript(expr)) {
+      return parser::Message{at,
+          "Variable '%s' has a vector subscript"_because_en_US,
+          expr.AsFortran()};
+    }
+    if (FindPureProcedureContaining(scope) &&
+        evaluate::ExtractCoarrayRef(expr)) {
+      return parser::Message(at,
+          "A pure subprogram may not define the coindexed object '%s'"_because_en_US,
+          expr.AsFortran());
+    }
+    return WhyNotDefinable(at, scope, flags, *dataRef);
+  }
+  if (evaluate::IsVariable(expr)) {
+    return std::nullopt; // result of function returning a pointer - ok
+  }
+  if (flags.test(DefinabilityFlag::PointerDefinition)) {
+    if (const auto *procDesignator{
+            std::get_if<evaluate::ProcedureDesignator>(&expr.u)}) {
+      // Defining a procedure pointer
+      if (const Symbol * procSym{procDesignator->GetSymbol()}) {
+        if (evaluate::ExtractCoarrayRef(expr)) { // C1027
+          return BlameSymbol(at,
+              "Procedure pointer '%s' may not be a coindexed object"_because_en_US,
+              *procSym, expr.AsFortran());
+        }
+        if (const auto *component{procDesignator->GetComponent()}) {
+          return WhyNotDefinable(at, scope, flags, *component);
+        } else {
+          return WhyNotDefinable(at, scope, flags, *procSym);
+        }
+      }
+    }
+  }
+  return parser::Message{
+      at, "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
+}
+
+} // namespace Fortran::semantics

flang/lib/Semantics/expression.cpp

if (symbol) {
             if (it->test(Symbol::Flag::ParentComp)) {
               unavailable.insert(it->name());
             }
           }
         }
       }
       unavailable.insert(symbol->name());
       if (value) {
+        const auto &innermost{context_.FindScope(expr.source)};
         if (symbol->has<semantics::ProcEntityDetails>()) {
           CHECK(IsPointer(*symbol));
         } else if (symbol->has<semantics::ObjectEntityDetails>()) {
           // C1594(4)
-          const auto &innermost{context_.FindScope(expr.source)};
           if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
             if (const Symbol * pointer{FindPointerComponent(*symbol)}) {
               if (const Symbol *
                   object{FindExternallyVisibleObject(*value, *pureProc)}) {
                 if (auto *msg{Say(expr.source,
                         "Externally visible object '%s' may not be "
                         "associated with pointer component '%s' in a "
                         "pure procedure"_err_en_US,
if (symbol) {
         } else {
           Say(expr.source,
               "Component '%s' is neither a procedure pointer "
               "nor a data object"_err_en_US,
               symbol->name());
           continue;
         }
         if (IsPointer(*symbol)) {
-          semantics::CheckPointerAssignment(
-              GetFoldingContext(), *symbol, *value); // C7104, C7105
+          semantics::CheckStructConstructorPointerComponent(
+              GetFoldingContext(), *symbol, *value, innermost); // C7104, C7105
           result.Add(*symbol, Fold(std::move(*value)));
         } else if (MaybeExpr converted{
                        ConvertToType(*symbol, std::move(*value))}) {
           if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
             if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
               if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
                 AttachDeclaration(
                     Say(expr.source,

flang/lib/Semantics/pointer-assignment.h

 class FoldingContext;
 }
 
 namespace Fortran::semantics {
 
 class Symbol;
 
 bool CheckPointerAssignment(
-    evaluate::FoldingContext &, const evaluate::Assignment &);
+    evaluate::FoldingContext &, const evaluate::Assignment &, const Scope &);
 bool CheckPointerAssignment(evaluate::FoldingContext &, const SomeExpr &lhs,
-    const SomeExpr &rhs, bool isBoundsRemapping = false);
-bool CheckPointerAssignment(
-    evaluate::FoldingContext &, const Symbol &lhs, const SomeExpr &rhs);
+    const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
+bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &,
+    const Symbol &lhs, const SomeExpr &rhs, const Scope &);
 bool CheckPointerAssignment(evaluate::FoldingContext &,
     parser::CharBlock source, const std::string &description,
-    const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs);
+    const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
+    const Scope &);
 
 // Checks whether an expression is a valid static initializer for a
 // particular pointer designator.
-bool CheckInitialTarget(
-    evaluate::FoldingContext &, const SomeExpr &pointer, const SomeExpr &init);
+bool CheckInitialTarget(evaluate::FoldingContext &, const SomeExpr &pointer,
+    const SomeExpr &init, const Scope &);
 
 } // namespace Fortran::semantics
 
 #endif // FORTRAN_SEMANTICS_POINTER_ASSIGNMENT_H_

flang/lib/Semantics/pointer-assignment.cpp

 //===-- lib/Semantics/pointer-assignment.cpp ------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "pointer-assignment.h"
+#include "definable.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/restorer.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parse-tree-visitor.h"

 using evaluate::characteristics::Procedure;
 using evaluate::characteristics::TypeAndShape;
 using parser::MessageFixedText;
 using parser::MessageFormattedText;
 
 class PointerAssignmentChecker {
 public:
   PointerAssignmentChecker(evaluate::FoldingContext &context,
-      parser::CharBlock source, const std::string &description)
-      : context_{context}, source_{source}, description_{description} {}
-  PointerAssignmentChecker(evaluate::FoldingContext &context, const Symbol &lhs)
-      : context_{context}, source_{lhs.name()},
+      const Scope &scope, parser::CharBlock source,
+      const std::string &description)
+      : context_{context}, scope_{scope}, source_{source}, description_{
+                                                               description} {}
+  PointerAssignmentChecker(
+      evaluate::FoldingContext &context, const Scope &scope, const Symbol &lhs)
+      : context_{context}, scope_{scope}, source_{lhs.name()},
         description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
     set_lhsType(TypeAndShape::Characterize(lhs, context));
     set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
     set_isVolatile(lhs.attrs().test(Attr::VOLATILE));
   }
   PointerAssignmentChecker &set_lhsType(std::optional<TypeAndShape> &&);
   PointerAssignmentChecker &set_isContiguous(bool);
   PointerAssignmentChecker &set_isVolatile(bool);
   PointerAssignmentChecker &set_isBoundsRemapping(bool);
+  bool CheckLeftHandSide(const SomeExpr &);
   bool Check(const SomeExpr &);
 
 private:
   bool CharacterizeProcedure();
   template <typename T> bool Check(const T &);
   template <typename T> bool Check(const evaluate::Expr<T> &);
   template <typename T> bool Check(const evaluate::FunctionRef<T> &);
   template <typename T> bool Check(const evaluate::Designator<T> &);
   bool Check(const evaluate::NullPointer &);
   bool Check(const evaluate::ProcedureDesignator &);
   bool Check(const evaluate::ProcedureRef &);
   // Target is a procedure
   bool Check(parser::CharBlock rhsName, bool isCall,
       const Procedure * = nullptr,
       const evaluate::SpecificIntrinsic *specific = nullptr);
   bool LhsOkForUnlimitedPoly() const;
   template <typename... A> parser::Message *Say(A &&...);
 
   evaluate::FoldingContext &context_;
+  const Scope &scope_;
   const parser::CharBlock source_;
   const std::string description_;
   const Symbol *lhs_{nullptr};
   std::optional<TypeAndShape> lhsType_;
   std::optional<Procedure> procedure_;
   bool characterizedProcedure_{false};
   bool isContiguous_{false};
   bool isVolatile_{false};
if (!characterizedProcedure_) {
     characterizedProcedure_ = true;
     if (lhs_ && IsProcedure(*lhs_)) {
       procedure_ = Procedure::Characterize(*lhs_, context_);
     }
   }
   return procedure_.has_value();
 }
 
+bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
+  if (auto whyNot{WhyNotDefinable(context_.messages().at(), scope_,
+          DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
+    if (auto *msg{context_.messages().Say(
+            "The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
+      msg->Attach(std::move(*whyNot));
+    }
+    return false;
+  } else {
+    return true;
+  }
+}
+
 template <typename T> bool PointerAssignmentChecker::Check(const T &) {
   // Catch-all case for really bad target expression
   Say("Target associated with %s must be a designator or a call to a"
       " pointer-valued function"_err_en_US,
       description_);
   return false;
 }
 
static bool CheckPointerBounds(
   if (isBoundsRemapping && rhs.Rank() != 1 &&
       !evaluate::IsSimplyContiguous(rhs, context)) {
     messages.Say("Pointer bounds remapping target must have rank 1 or be"
                  " simply contiguous"_err_en_US); // 10.2.2.3(9)
   }
   return isBoundsRemapping;
 }
 
-bool CheckPointerAssignment(
-    evaluate::FoldingContext &context, const evaluate::Assignment &assignment) {
-  return CheckPointerAssignment(context, assignment.lhs, assignment.rhs,
+bool CheckPointerAssignment(evaluate::FoldingContext &context,
+    const evaluate::Assignment &assignment, const Scope &scope) {
+  return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
       CheckPointerBounds(context, assignment));
 }
 
 bool CheckPointerAssignment(evaluate::FoldingContext &context,
-    const SomeExpr &lhs, const SomeExpr &rhs, bool isBoundsRemapping) {
+    const SomeExpr &lhs, const SomeExpr &rhs, const Scope &scope,
+    bool isBoundsRemapping) {
   const Symbol *pointer{GetLastSymbol(lhs)};
   if (!pointer) {
     return false; // error was reported
   }
-  if (!IsPointer(pointer->GetUltimate())) {
-    evaluate::SayWithDeclaration(context.messages(), *pointer,
-        "'%s' is not a pointer"_err_en_US, pointer->name());
-    return false;
-  }
-  if (pointer->has<ProcEntityDetails>() && evaluate::ExtractCoarrayRef(lhs)) {
-    context.messages().Say( // C1027
-        "Procedure pointer may not be a coindexed object"_err_en_US);
-    return false;
-  }
-  return PointerAssignmentChecker{context, *pointer}
-      .set_isBoundsRemapping(isBoundsRemapping)
-      .Check(rhs);
+  PointerAssignmentChecker checker{context, scope, *pointer};
+  checker.set_isBoundsRemapping(isBoundsRemapping);
+  return checker.CheckLeftHandSide(lhs) & checker.Check(rhs);
 }
 
-bool CheckPointerAssignment(
-    evaluate::FoldingContext &context, const Symbol &lhs, const SomeExpr &rhs) {
+bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &context,
+    const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
   CHECK(IsPointer(lhs));
-  return PointerAssignmentChecker{context, lhs}.Check(rhs);
+  return PointerAssignmentChecker{context, scope, lhs}.Check(rhs);
 }
 
 bool CheckPointerAssignment(evaluate::FoldingContext &context,
     parser::CharBlock source, const std::string &description,
-    const DummyDataObject &lhs, const SomeExpr &rhs) {
-  return PointerAssignmentChecker{context, source, description}
+    const DummyDataObject &lhs, const SomeExpr &rhs, const Scope &scope) {
+  return PointerAssignmentChecker{context, scope, source, description}
       .set_lhsType(common::Clone(lhs.type))
       .set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
       .set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
       .Check(rhs);
 }
 
 bool CheckInitialTarget(evaluate::FoldingContext &context,
-    const SomeExpr &pointer, const SomeExpr &init) {
+    const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
   return evaluate::IsInitialDataTarget(init, &context.messages()) &&
-      CheckPointerAssignment(context, pointer, init);
+      CheckPointerAssignment(context, pointer, init, scope);
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names.cpp

 //===-- lib/Semantics/resolve-names.cpp -----------------------------------===//
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "resolve-names.h"
 #include "assignment.h"
+#include "definable.h"
 #include "mod-file.h"
 #include "pointer-assignment.h"
 #include "program-tree.h"
 #include "resolve-directives.h"
 #include "resolve-names-utils.h"
 #include "rewrite-parse-tree.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/default-kinds.h"
if (type->IsPolymorphic() && IsDummy(symbol) &&
       return false;
     }
   }
   if (IsAssumedSizeArray(symbol)) { // C1128
     SayWithDecl(name, symbol,
         "Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
     return false;
   }
-  if (std::optional<Message> msg{WhyNotModifiable(symbol, currScope())}) {
+  if (std::optional<Message> whyNot{WhyNotDefinable(
+          name.source, currScope(), DefinabilityFlags{}, symbol)}) {
     SayWithReason(name, symbol,
         "'%s' may not appear in a locality-spec because it is not "
         "definable"_err_en_US,
-        std::move(*msg));
+        std::move(*whyNot));
     return false;
   }
   return PassesSharedLocalityChecks(name, symbol);
 }
 
 Symbol &DeclarationVisitor::FindOrDeclareEnclosingEntity(
     const parser::Name &name) {
   Symbol *prev{FindSymbol(name)};

flang/lib/Semantics/tools.cpp

 }
 
 bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
   const auto &objects{block.get<CommonBlockDetails>().objects()};
   return llvm::is_contained(objects, object);
 }
 
 bool IsUseAssociated(const Symbol &symbol, const Scope &scope) {
-  const Scope &owner{
-      GetProgramUnitOrBlockConstructContaining(symbol.GetUltimate().owner())};
+  const Scope &owner{GetTopLevelUnitContaining(symbol.GetUltimate().owner())};
   return owner.kind() == Scope::Kind::Module &&
-      owner != GetProgramUnitOrBlockConstructContaining(scope);
+      owner != GetTopLevelUnitContaining(scope);
 }
 
 bool DoesScopeContain(
     const Scope *maybeAncestor, const Scope &maybeDescendent) {
   return maybeAncestor && !maybeDescendent.IsTopLevel() &&
       FindScopeContaining(maybeDescendent.parent(),
           [&](const Scope &scope) { return &scope == maybeAncestor; });
 }

 }
 
 const Symbol *FindPointerComponent(const Symbol &symbol) {
   return IsPointer(symbol) ? &symbol : FindPointerComponent(symbol.GetType());
 }
 
 // C1594 specifies several ways by which an object might be globally visible.
 const Symbol *FindExternallyVisibleObject(
-    const Symbol &object, const Scope &scope) {
+    const Symbol &object, const Scope &scope, bool isPointerDefinition) {
   // TODO: Storage association with any object for which this predicate holds,
   // once EQUIVALENCE is supported.
   const Symbol &ultimate{GetAssociationRoot(object)};
   if (IsDummy(ultimate)) {
     if (IsIntentIn(ultimate)) {
       return &ultimate;
     }
-    if (IsPointer(ultimate) && IsPureProcedure(ultimate.owner()) &&
-        IsFunction(ultimate.owner())) {
+    if (!isPointerDefinition && IsPointer(ultimate) &&
+        IsPureProcedure(ultimate.owner()) && IsFunction(ultimate.owner())) {
       return &ultimate;
     }
+  } else if (ultimate.owner().IsDerivedType()) {
+    return nullptr;
   } else if (&GetProgramUnitContaining(ultimate) !=
       &GetProgramUnitContaining(scope)) {
     return &object;
   } else if (const Symbol * block{FindCommonBlockContaining(ultimate)}) {
     return block;
   }
   return nullptr;
 }
for (const Symbol &symbol : associated) {
     limit = std::max(limit, symbol.offset() + symbol.size());
   }
   return result;
 }
 
 bool IsModuleProcedure(const Symbol &symbol) {
   return ClassifyProcedure(symbol) == ProcedureDefinitionClass::Module;
 }
-const Symbol *IsExternalInPureContext(
-    const Symbol &symbol, const Scope &scope) {
-  if (const auto *pureProc{FindPureProcedureContaining(scope)}) {
-    return FindExternallyVisibleObject(symbol.GetUltimate(), *pureProc);
-  }
-  return nullptr;
-}
 
 PotentialComponentIterator::const_iterator FindPolymorphicPotentialComponent(
     const DerivedTypeSpec &derived) {
   PotentialComponentIterator potentials{derived};
   return std::find_if(
       potentials.begin(), potentials.end(), [](const Symbol &component) {
         if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
           const DeclTypeSpec *type{details->type()};
if (const DeclTypeSpec * type{details->type()}) {
       if (const DerivedTypeSpec * derived{type->AsDerived()}) {
         return (bool)FindPolymorphicPotentialComponent(*derived);
       }
     }
   }
   return false;
 }
 
-bool InProtectedContext(const Symbol &symbol, const Scope &currentScope) {
-  return IsProtected(symbol) && !IsHostAssociated(symbol, currentScope);
-}
-
-// C1101 and C1158
-// Modifiability checks on the leftmost symbol ("base object")
-// of a data-ref
-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 parser::Message{at,
-        "'%s' is externally visible and referenced in a pure"
-        " procedure"_en_US,
-        symbol.name()};
-  } else if (!IsVariableName(symbol)) {
-    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
-static std::optional<parser::Message> WhyNotModifiableLast(
-    parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
-  if (IsOrContainsEventOrLockComponent(symbol)) {
-    return parser::Message{at,
-        "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US,
-        symbol.name()};
-  } else {
-    return std::nullopt;
-  }
-}
-
-// 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.
-static std::optional<parser::Message> WhyNotModifiableIfNoPtr(
-    parser::CharBlock at, const Symbol &symbol, const Scope &scope) {
-  if (InProtectedContext(symbol, scope)) {
-    return parser::Message{
-        at, "'%s' is protected in this scope"_en_US, symbol.name()};
-  } else if (IsIntentIn(symbol)) {
-    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::Message> WhyNotModifiable(
-    const Symbol &original, const Scope &scope) {
-  const Symbol &symbol{GetAssociationRoot(original)};
-  if (auto first{WhyNotModifiableFirst(symbol.name(), symbol, scope)}) {
-    return first;
-  } else if (auto last{WhyNotModifiableLast(symbol.name(), symbol, scope)}) {
-    return last;
-  } else if (!IsPointer(symbol)) {
-    return WhyNotModifiableIfNoPtr(symbol.name(), symbol, scope);
-  } else {
-    return std::nullopt;
-  }
-}
-
-// Modifiability checks for a data-ref
-std::optional<parser::Message> WhyNotModifiable(parser::CharBlock at,
-    const SomeExpr &expr, const Scope &scope, bool vectorSubscriptIsOk) {
-  if (auto dataRef{evaluate::ExtractDataRef(expr, true)}) {
-    if (!vectorSubscriptIsOk && evaluate::HasVectorSubscript(expr)) {
-      return parser::Message{at, "Variable has a vector subscript"_en_US};
-    }
-    const Symbol &first{GetAssociationRoot(dataRef->GetFirstSymbol())};
-    if (auto maybeWhyFirst{WhyNotModifiableFirst(at, first, scope)}) {
-      return maybeWhyFirst;
-    }
-    const Symbol &last{dataRef->GetLastSymbol()};
-    if (auto maybeWhyLast{WhyNotModifiableLast(at, last, scope)}) {
-      return maybeWhyLast;
-    }
-    if (!GetLastPointerSymbol(*dataRef)) {
-      if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(at, first, scope)}) {
-        return maybeWhyFirst;
-      }
-    }
-  } else if (!evaluate::IsVariable(expr)) {
-    return parser::Message{
-        at, "'%s' is not a variable"_en_US, expr.AsFortran()};
-  } else {
-    // reference to function returning POINTER
-  }
-  return std::nullopt;
-}
-
 class ImageControlStmtHelper {
   using ImageControlStmts =
       std::variant<parser::ChangeTeamConstruct, parser::CriticalConstruct,
           parser::EventPostStmt, parser::EventWaitStmt, parser::FormTeamStmt,
           parser::LockStmt, parser::SyncAllStmt, parser::SyncImagesStmt,
           parser::SyncMemoryStmt, parser::SyncTeamStmt, parser::UnlockStmt>;
 
 public:

flang/test/Semantics/OpenMP/omp-lastprivate01.f90

program omp_lastprivate
   use protected_var
   integer :: i, a(10), b(10), c(10)
   integer, parameter :: k = 10
 
   a = 10
   b = 20
 
   !ERROR: Variable 'k' on the LASTPRIVATE clause is not definable
+  !BECAUSE: 'k' is not a variable
   !$omp parallel do lastprivate(k)
   do i = 1, 10
     c(i) = a(i) + b(i) + k
   end do
   !$omp end parallel do
 
   !ERROR: Variable 'p' on the LASTPRIVATE clause is not definable
+  !BECAUSE: 'p' is protected in this scope
   !$omp parallel do lastprivate(p)
   do i = 1, 10
     c(i) = a(i) + b(i) + k
   end do
   !$omp end parallel do
 
   call omp_lastprivate_sb(i)
 
   print *, c
 
 end program omp_lastprivate
 
 subroutine omp_lastprivate_sb(m)
   integer :: i, a(10), b(10), c(10)
   integer, intent(in) :: m
 
   a = 10
   b = 20
 
   !ERROR: Variable 'm' on the LASTPRIVATE clause is not definable
+  !BECAUSE: 'm' is an INTENT(IN) dummy argument
   !$omp parallel do lastprivate(m)
   do i = 1, 10
     c(i) = a(i) + b(i) + m
   end do
   !$omp end parallel do
 
   print *, c
 
 end subroutine omp_lastprivate_sb

flang/test/Semantics/OpenMP/omp-reduction04.f90

 ! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
 ! OpenMP Version 4.5
 ! 2.15.3.6 Reduction Clause
 program omp_Reduction
   integer :: i
   integer, parameter :: k = 10
   common /c/ a, b
 
   !ERROR: Variable 'k' on the REDUCTION clause is not definable
+  !BECAUSE: 'k' is not a variable
   !$omp parallel do reduction(+:k)
   do i = 1, 10
     l = k + 1
   end do
   !$omp end parallel do
 
   !ERROR: Variable 'c' on the REDUCTION clause is not definable
+  !BECAUSE: 'c' is not a variable
   !$omp parallel do reduction(*:/c/)
   do i = 1, 10
     l = k + 1
   end do
   !$omp end parallel do
 end program omp_Reduction

flang/test/Semantics/assign02.f90

contains
   subroutine s6
     real, target :: x
     real :: p
     type :: tp
       real, pointer :: a
       real :: b
     end type
     type(tp) :: y
-    !ERROR: 'p' is not a pointer
+    !ERROR: The left-hand side of a pointer assignment is not definable
+    !BECAUSE: 'p' is not a pointer
     p => x
     y%a => x
-    !ERROR: 'b' is not a pointer
+    !ERROR: The left-hand side of a pointer assignment is not definable
+    !BECAUSE: 'b' is not a pointer
     y%b => x
   end
 
   !C1025 (R1037) The expr shall be a designator that designates a
   !variable with either the TARGET or POINTER attribute and is not
   !an array section with a vector subscript, or it shall be a reference
   !to a function that returns a data pointer.
   subroutine s7

flang/test/Semantics/assign03.f90

type :: t
     real, pointer :: q
   end type
 contains
   ! C1027
   subroutine s1
     type(t), allocatable :: a(:)
     type(t), allocatable :: b[:]
     a(1)%p => s
-    !ERROR: Procedure pointer may not be a coindexed object
+    !ERROR: The left-hand side of a pointer assignment is not definable
+    !BECAUSE: Procedure pointer 'p' may not be a coindexed object
     b[1]%p => s
   end
   ! C1028
   subroutine s2
     type(t) :: a
     a%p => s
     !ERROR: In assignment to object pointer 'q', the target 's' is a procedure designator
     a%q => s

flang/test/Semantics/assign04.f90

subroutine s2(x)
   !ERROR: A dummy argument may not also be a named constant
   real, parameter :: x = 0.0
   real, parameter :: a(*) = [1, 2, 3]
   character, parameter :: c(2) = "ab"
   integer :: i
   !ERROR: Assignment to constant 'x' is not allowed
   x = 2.0
   i = 2
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'a' is not a variable
   a(i) = 3.0
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'a' is not a variable
   a(i:i+1) = [4, 5]
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'c' is not a variable
   c(i:2) = "cd"
 end
 
 ! C901
 subroutine s3
   type :: t
     integer :: a(2)
     integer :: b
   end type
   type(t) :: x
   type(t), parameter :: y = t([1,2], 3)
   integer :: i = 1
   x%a(i) = 1
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'y' is not a variable
   y%a(i) = 2
   x%b = 4
   !ERROR: Assignment to constant 'y%b' is not allowed
   y%b = 5
 end
 
 ! C844
 subroutine s4
   type :: t
     integer :: a(2)
   end type
 contains
   subroutine s(x, c)
     type(t), intent(in) :: x
     character(10), intent(in) :: c
     type(t) :: y
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
     x = y
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
     x%a(1) = 2
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'c' is an INTENT(IN) dummy argument
     c(2:3) = "ab"
   end
 end
 
 ! 8.5.15(2)
 module m5
   real :: x
   real, protected :: y
   real, private :: z
   type :: t
     real :: a
   end type
   type(t), protected :: b
 end
 subroutine s5()
   use m5
   implicit none
   x = 1.0
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'y' is protected in this scope
   y = 2.0
   !ERROR: No explicit type declared for 'z'
   z = 3.0
-  !ERROR: Left-hand side of assignment is not modifiable
+  !ERROR: Left-hand side of assignment is not definable
+  !BECAUSE: 'b' is protected in this scope
   b%a = 1.0
 end
 
 subroutine s6(x)
   integer :: x(*)
   x(1:3) = [1, 2, 3]
   x(:3) = [1, 2, 3]
   !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value

flang/test/Semantics/atomic02.f90

program test_atomic_and
   call atomic_and(scalar_coarray, val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_and(scalar_coarray, val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_and' may not be a coindexed object
   call atomic_and(scalar_coarray, val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_and(scalar_coarray, val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_and()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_and(value=val, stat=status)
 

flang/test/Semantics/atomic03.f90

! mismatches on 'stat' argument
   call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, status_array)
 
   !ERROR: 'stat' argument to 'atomic_cas' may not be a coindexed object
   call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_cas(int_scalar_coarray, old_int, compare_int, new_int, 1)
 
 ! missing mandatory arguments
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_cas()
 
   !ERROR: missing mandatory 'atom=' argument

flang/test/Semantics/atomic04.f90

program test_atomic_define
   call atomic_define(scalar_coarray, val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_define(scalar_coarray, val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_define' may not be a coindexed object
   call atomic_define(scalar_coarray, val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_define(scalar_coarray, val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_define()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_define(value=val, stat=status)
 

flang/test/Semantics/atomic05.f90

program test_atomic_fetch_add
   call atomic_fetch_add(scalar_coarray, val, old_val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_fetch_add(scalar_coarray, val, old_val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_fetch_add' may not be a coindexed object
   call atomic_fetch_add(scalar_coarray, val, old_val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_fetch_add(scalar_coarray, val, old_val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_add()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_add(value=val, old=old_val, stat=status)
 

flang/test/Semantics/atomic06.f90

program test_atomic_fetch_and
   call atomic_fetch_and(scalar_coarray, val, old_val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_fetch_and(scalar_coarray, val, old_val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_fetch_and' may not be a coindexed object
   call atomic_fetch_and(scalar_coarray, val, old_val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_fetch_and(scalar_coarray, val, old_val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_and()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_and(value=val, old=old_val, stat=status)
 

flang/test/Semantics/atomic07.f90

program test_atomic_fetch_or
   call atomic_fetch_or(scalar_coarray, val, old_val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_fetch_or' may not be a coindexed object
   call atomic_fetch_or(scalar_coarray, val, old_val, coindexed_status[1])
 
   !ERROR: 'stat' argument to 'atomic_fetch_or' may not be a coindexed object
   call atomic_fetch_or(scalar_coarray[1], val_coarray[1], old_val_coarray[1], coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_fetch_or(scalar_coarray, val, old_val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_or()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_or(value=val, old=old_val, stat=status)
 

flang/test/Semantics/atomic08.f90

program test_atomic_fetch_xor
   call atomic_fetch_xor(scalar_coarray, val, old_val, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_fetch_xor(scalar_coarray, val, old_val, status_array)
 
   !ERROR: 'stat' argument to 'atomic_fetch_xor' may not be a coindexed object
   call atomic_fetch_xor(scalar_coarray, val, old_val, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_fetch_xor(scalar_coarray, val, old_val, 1)
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_xor()
 
   !ERROR: missing mandatory 'atom=' argument
   call atomic_fetch_xor(value=val, old=old_val, stat=status)
 

flang/test/Semantics/atomic10.f90

program test_atomic_ref
   call atomic_ref(val, scalar_coarray, non_integer)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call atomic_ref(val, scalar_coarray, status_array)
 
   !ERROR: 'stat' argument to 'atomic_ref' may not be a coindexed object
   call atomic_ref(val, scalar_coarray, coindexed_status[1])
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '1_4' is not a variable or pointer
   call atomic_ref(val, scalar_coarray, 1)
 
   !ERROR: missing mandatory 'value=' argument
   call atomic_ref()
 
   !ERROR: missing mandatory 'value=' argument
   call atomic_ref(atom=scalar_coarray, stat=status)
 

flang/test/Semantics/call03.f90

subroutine test10(a) ! 15.5.2.4(16)
     !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
     call assumedshape(a)
   end subroutine
 
   subroutine test11(in) ! C15.5.2.4(20)
     real, intent(in) :: in
     real :: x
     x = 0.
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'in' is an INTENT(IN) dummy argument
     call intentout(in)
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
     call intentout(3.14159)
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'in+1._4' is not a variable or pointer
     call intentout(in + 1.)
     call intentout(x) ! ok
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: '(x)' is not a variable or pointer
     call intentout((x))
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
+    !BECAUSE: '2_4' is not a variable or pointer
     call system_clock(count=2)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'in' is an INTENT(IN) dummy argument
     call intentinout(in)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: '3.141590118408203125_4' is not a variable or pointer
     call intentinout(3.14159)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'in+1._4' is not a variable or pointer
     call intentinout(in + 1.)
     call intentinout(x) ! ok
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: '(x)' is not a variable or pointer
     call intentinout((x))
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
+    !BECAUSE: '0_4' is not a variable or pointer
     call execute_command_line(command="echo hello", exitstat=0)
   end subroutine
 
   subroutine test12 ! 15.5.2.4(21)
     real :: a(1)
     integer :: j(1)
     j(1) = 1
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
     call intentout_arr(a(j))
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
     call intentinout_arr(a(j))
     call asynchronous_arr(a(j)) ! ok
     call volatile_arr(a(j)) ! ok
   end subroutine
 
   subroutine coarr(x)
     type(ultimateCoarray):: x
   end subroutine

flang/test/Semantics/call06.f90

subroutine test(x)
     call s03(com) ! ok
     !ERROR: ALLOCATABLE dummy argument 'x=' has corank 1 but actual argument has corank 2
     call s02(com)
     !ERROR: ALLOCATABLE dummy argument 'x=' has corank 2 but actual argument has corank 1
     call s03(cov)
     call s04(cov[1]) ! ok
     !ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument
     call s01(cov[1])
-    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
     call s05(x)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
     call s06(x)
   end subroutine
 end module

flang/test/Semantics/call10.f90

pure subroutine s10 ! C1595
     !ERROR: Procedure 'notpure' referenced in pure subprogram 's10' must be pure too
     n = notpure(1)
   end subroutine
   pure subroutine s11(to) ! C1596
     ! Implicit deallocation at the end of the subroutine
     !ERROR: Deallocation of polymorphic object 'auto%a' is not permitted in a pure subprogram
     type(polyAlloc) :: auto
     type(polyAlloc), intent(in out) :: to
-    !ERROR: Deallocation of polymorphic non-coarray component '%a' is not permitted in a pure subprogram
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'to' has polymorphic non-coarray component '%a' in a pure subprogram
     to = auto
   end subroutine
   pure subroutine s12
     character(20) :: buff
     real :: x
     write(buff, *) 1.0 ! ok
     read(buff, *) x ! ok
     !ERROR: External I/O is not allowed in a pure subprogram

flang/test/Semantics/call12.f90

pure function test(ptr, in, hpd)
     type(t), target :: y, z
     type(hasPtr) :: hp
     type(hasPtr), intent(in) :: hpd
     type(hasPtr), allocatable :: alloc
     type(hasCoarray), pointer :: hcp
     integer :: n
     common /block/ y
     external :: extfunc
-    !ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'x' may not be defined in pure subprogram 'test' because it is host-associated
     x%a = 0.
-    !ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'y' may not be defined in pure subprogram 'test' because it is in a COMMON block
     y%a = 0. ! C1594(1)
-    !ERROR: Pure subprogram 'test' may not define 'useassociated' because it is USE-associated
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'useassociated' may not be defined in pure subprogram 'test' because it is USE-associated
     useassociated = 0.  ! C1594(1)
-    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
     ptr%a = 0. ! C1594(1)
-    !ERROR: Pure subprogram 'test' may not define 'in' because it is an INTENT(IN) dummy argument
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'in' is an INTENT(IN) dummy argument
     in%a = 0. ! C1594(1)
-    !ERROR: A pure subprogram may not define a coindexed object
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: A pure subprogram may not define the coindexed object 'hcp%co[1_8]'
     hcp%co[1] = 0. ! C1594(1)
-    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+    !ERROR: The left-hand side of a pointer assignment is not definable
+    !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
     ptr => z ! C1594(2)
-    !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
+    !ERROR: 'ptr' may not appear in NULLIFY
+    !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
     nullify(ptr) ! C1594(2), 19.6.8
     !ERROR: A pure subprogram may not use 'ptr' as the target of pointer assignment because it is a POINTER dummy argument of a pure function
     ptr2 => ptr ! C1594(3)
     !ERROR: A pure subprogram may not use 'in' as the target of pointer assignment because it is an INTENT(IN) dummy argument
     ptr2 => in ! C1594(3)
     !ERROR: A pure subprogram may not use 'y' as the target of pointer assignment because it is in a COMMON block
     ptr2 => y ! C1594(2)
     !ERROR: Externally visible object 'block' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(y%a)]) ! C1594(4)
     !ERROR: Externally visible object 'x' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(x%a)]) ! C1594(4)
     !ERROR: Externally visible object 'ptr' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(ptr%a)]) ! C1594(4)
     !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(in%a)]) ! C1594(4)
     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
     hp = hpd ! C1594(5)
     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
     allocate(alloc, source=hpd)
     !ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
     n = f00(extfunc)
    contains
     pure subroutine internal
       type(hasPtr) :: localhp
-      !ERROR: Pure subprogram 'internal' may not define 'z' because it is host-associated
+      !ERROR: Left-hand side of assignment is not definable
+      !BECAUSE: 'z' may not be defined in pure subprogram 'internal' because it is host-associated
       z%a = 0.
       !ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
       localhp = hasPtr(z%a)
     end subroutine
   end function
 end module

flang/test/Semantics/collectives01.f90

program test_co_sum
   !ERROR: keyword argument to intrinsic 'co_sum' was supplied positionally by an earlier actual argument
   call co_sum(i, 1, status, message, errmsg=repeated_message)
 
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
   call co_sum(bool)
 
   ! argument 'a' is intent(inout)
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_sum(a=1+1)
 
   !ERROR: 'a' argument to 'co_sum' may not be a coindexed object
   call co_sum(a=coindexed_real[1])
 
   ! 'result_image' argument shall be a integer
   !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_sum(i, result_image=bool)
 
   ! 'result_image' argument shall be an integer scalar
   !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_sum(c, result_image=integer_array)
 
   ! argument 'stat' shall be intent(out)
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_sum(a=i, result_image=1, stat=1+1, errmsg=message)
 
   !ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
   call co_sum(d, stat=coindexed_integer[1])
 
   !ERROR: 'stat' argument to 'co_sum' may not be a coindexed object
   call co_sum(stat=coindexed_integer[1], a=d)
 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_sum(r, stat=message)
 
   ! 'stat' argument shall be an integer scalar
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_sum(i, stat=integer_array)
 
   ! 'errmsg' argument shall be intent(inout)
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+  !BECAUSE: '"c"' is not a variable or pointer
   call co_sum(a=i, result_image=1, stat=status, errmsg='c')
 
   !ERROR: 'errmsg' argument to 'co_sum' may not be a coindexed object
   call co_sum(c, errmsg=coindexed_character[1])
 
   ! 'errmsg' argument shall be a character
   !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_sum(c, errmsg=i)

flang/test/Semantics/collectives02.f90

program test_co_min
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
   call co_min(bool)
 
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
   call co_min(complex_type)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_min(a=1+1)
 
   !ERROR: 'a' argument to 'co_min' may not be a coindexed object
   call co_min(a=coindexed_real[1])
 
   !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_min(i, result_image=bool)
 
   !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_min(c, result_image=integer_array)
 
   !ERROR: 'stat' argument to 'co_min' may not be a coindexed object
   call co_min(d, stat=coindexed_integer[1])
 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_min(r, stat=message)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_min(i, stat=integer_array)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+  !BECAUSE: '"c"' is not a variable or pointer
   call co_min(a=i, result_image=1, stat=status, errmsg='c')
 
   !ERROR: 'errmsg' argument to 'co_min' may not be a coindexed object
   call co_min(c, errmsg=coindexed_character[1])
 
   ! 'errmsg' argument shall be a character
   !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_min(c, errmsg=i)

flang/test/Semantics/collectives03.f90

program test_co_max
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
   call co_max(bool)
 
   ! argument 'a' shall be of numeric type
   !ERROR: Actual argument for 'a=' has bad type 'COMPLEX(4)'
   call co_max(complex_type)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_max(a=1+1)
 
   !ERROR: 'a' argument to 'co_max' may not be a coindexed object
   call co_max(a=coindexed_real[1])
 
   !ERROR: Actual argument for 'result_image=' has bad type 'LOGICAL(4)'
   call co_max(i, result_image=bool)
 
   !ERROR: 'result_image=' argument has unacceptable rank 1
   call co_max(c, result_image=integer_array)
 
   !ERROR: 'stat' argument to 'co_max' may not be a coindexed object
   call co_max(d, stat=coindexed_integer[1])
 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_max(r, stat=message)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_max(i, stat=integer_array)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+  !BECAUSE: '"c"' is not a variable or pointer
   call co_max(a=i, result_image=1, stat=status, errmsg='c')
 
   !ERROR: 'errmsg' argument to 'co_max' may not be a coindexed object
   call co_max(c, errmsg=coindexed_character[1])
 
   ! 'errmsg' argument shall be a character
   !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_max(c, errmsg=i)

flang/test/Semantics/collectives04.f90

program test_co_broadcast
   call co_broadcast(source_image=1, stat=status, errmsg=message)
 
   !ERROR: missing mandatory 'source_image=' argument
   call co_broadcast(c)
 
   !ERROR: missing mandatory 'source_image=' argument
   call co_broadcast(a=c, stat=status, errmsg=message)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_broadcast(a=1+1, source_image=1)
 
   !ERROR: 'a' argument to 'co_broadcast' may not be a coindexed object
   call co_broadcast(a=coindexed_real[1], source_image=1)
 
   ! 'source_image' argument shall be an integer
   !ERROR: Actual argument for 'source_image=' has bad type 'LOGICAL(4)'
   call co_broadcast(i, source_image=bool)
 
   ! 'source_image' argument shall be an integer scalar
   !ERROR: 'source_image=' argument has unacceptable rank 1
   call co_broadcast(c, source_image=integer_array)
 
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
+  !BECAUSE: '2_4' is not a variable or pointer
   call co_broadcast(a=i, source_image=1, stat=1+1, errmsg=message)
 
   !ERROR: 'stat' argument to 'co_broadcast' may not be a coindexed object
   call co_broadcast(d, stat=coindexed_integer[1], source_image=1)
 
   ! 'stat' argument shall be an integer
   !ERROR: Actual argument for 'stat=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
   call co_broadcast(r, stat=message, source_image=1)
 
   !ERROR: 'stat=' argument has unacceptable rank 1
   call co_broadcast(i, stat=integer_array, source_image=1)
 
-  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' must be definable
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'errmsg=' is not definable
+  !BECAUSE: '"c"' is not a variable or pointer
   call co_broadcast(a=i, source_image=1, stat=status, errmsg='c')
 
   !ERROR: 'errmsg' argument to 'co_broadcast' may not be a coindexed object
   call co_broadcast(c, errmsg=coindexed_character[1], source_image=1)
 
   ! 'errmsg' argument shall be a character
   !ERROR: Actual argument for 'errmsg=' has bad type 'INTEGER(4)'
   call co_broadcast(c, 1, status, i)

flang/test/Semantics/deallocate05.f90

 !ERROR: name in DEALLOCATE statement must be a variable name
 Deallocate(maxvalue)
 
 !ERROR: component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
 Deallocate(x%p)
 
 !ERROR: STAT may not be duplicated in a DEALLOCATE statement
 Deallocate(x, stat=s, stat=s)
-!ERROR: STAT variable 'const_s' must be definable
+!ERROR: STAT variable 'const_s' is not definable
+!BECAUSE: '13_4' is not a variable or pointer
 Deallocate(x, stat=const_s)
 !ERROR: ERRMSG may not be duplicated in a DEALLOCATE statement
 Deallocate(x, errmsg=ee, errmsg=ee)
 !ERROR: STAT may not be duplicated in a DEALLOCATE statement
 Deallocate(x, stat=s, errmsg=ee, stat=s)
 !ERROR: ERRMSG may not be duplicated in a DEALLOCATE statement
 Deallocate(x, stat=s, errmsg=ee, errmsg=ee)
 
 End Program deallocatetest

flang/test/Semantics/io01.f90

3 continue
 
   !ERROR: If STATUS='STREAM' appears, RECL must not appear
   open(10, access='st'//'ream', recl=13)
 
   !ERROR: Duplicate NEWUNIT specifier
   !ERROR: If NEWUNIT appears, FILE or STATUS must also appear
   open(newunit=n, newunit=nn, iostat=stat4)
 
-  !ERROR: NEWUNIT variable 'const_new_unit' must be definable
+  !ERROR: NEWUNIT variable 'const_new_unit' is not definable
+  !BECAUSE: '66_4' is not a variable or pointer
   open(newunit=const_new_unit, status=cc)
 
   !ERROR: Duplicate UNIT specifier
   open(unit=100, unit=100)
 
   !ERROR: Duplicate UNIT specifier
   open(101, delim=delim_(1), unit=102)
 

flang/test/Semantics/io02.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
   close(status='kept', unit=16)
 
   !ERROR: Invalid STATUS value 'old'
   close(status='old', unit=17)
 
   !Ok: trailing spaces ignored
   close(status='keep ', unit=17)
 
-  !ERROR: IOSTAT variable 'const_stat' must be definable
+  !ERROR: IOSTAT variable 'const_stat' is not definable
+  !BECAUSE: '6666_4' is not a variable or pointer
   close(14, iostat=const_stat)
 
 9 continue
 end

flang/test/Semantics/io03.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
   character(kind=1,len=50) internal_file
   character(kind=2,len=50) internal_file2
   character(kind=4,len=50) internal_file4
   character(kind=1,len=50) internal_fileA(20)
   character(kind=1,len=111) msg
   character(20) advance
   character(20) :: cvar;
   character, parameter :: const_internal_file = "(I6)"
-  character, parameter :: const_cvar = "Ceci n'est pas une pipe."
+  character, parameter :: const_cvar*(*) = "Ceci n'est pas une pipe."
   integer*1 stat1
   integer*2 stat2, id2
   integer*8 stat8
   integer :: iunit = 10
   integer, parameter :: junit = 11, const_size = 13, const_int = 15
   integer :: vv(10) = 7
 
   namelist /mmm/ mm1, mm2
read(10, '(I4)', advance='no', asynchronous='yes', blank='null', &
       pad='no', round='processor_defined', size=kk) jj
 
   read(internal_file2, *) jj
   read(internal_file4, *) jj
 
   !ERROR: Internal file must not have a vector subscript
   read(internal_fileA(vv), *) jj
 
-  !ERROR: Input variable 'const_int' must be definable
+  !ERROR: Input variable 'const_int' is not definable
+  !BECAUSE: '15_4' is not a variable or pointer
   read(11, *) const_int
 
-  !ERROR: SIZE variable 'const_size' must be definable
+  !ERROR: SIZE variable 'const_size' is not definable
+  !BECAUSE: '13_4' is not a variable or pointer
   read(11, pos=ipos, size=const_size, end=9)
 
-  !ERROR: Input variable 'const_cvar' must be definable
+  !ERROR: Input variable 'const_cvar' is not definable
+  !BECAUSE: '"Ceci n'est pas une pipe."' is not a variable or pointer
   read(11, *) const_cvar
 
-  !ERROR: Input variable 'const_cvar' must be definable
+  !ERROR: Input variable 'const_cvar(3:13)' is not definable
+  !BECAUSE: '"ci n'est pa"' is not a variable or pointer
   read(11, *) const_cvar(3:13)
 
   !ERROR: Duplicate IOSTAT specifier
   read(11, pos=ipos, iostat=stat1, iostat=stat2)
 
   !ERROR: Duplicate END specifier
   read(11, end=9, pos=ipos, end=9)
 
subroutine s(aa, n)
   type(tt) :: qq(20)
 
   vv = 1
 
   read(*, *) aa(n,1)
   read(*, *) aa(n:n+2,2)
   read(*, *) qq(2:5)%y
 
-  !ERROR: Input variable 'n' must be definable
+  !ERROR: Input variable 'n' is not definable
+  !BECAUSE: 'n' is an INTENT(IN) dummy argument
   read(*, *) n
 
   !ERROR: Whole assumed-size array 'aa' may not appear here without subscripts
   read(*, *) aa
 end

flang/test/Semantics/io04.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
   character(kind=1,len=50) internal_file
   character(kind=1,len=100) msg
   character(20) sign
-  character, parameter :: const_internal_file = "(I6)"
+  character, parameter :: const_internal_file*(*) = "(I6)"
   integer*1 stat1, id1
   integer*2 stat2
   integer*4 stat4
   integer*8 stat8
   integer :: iunit = 10
   integer, parameter :: junit = 11
   integer, pointer :: a(:)
   integer, parameter :: const_id = 66666
! RUN: %python %S/test_errors.py %s %flang_fc1
   !ERROR: WRITE statement must not have a PAD specifier
   write(*, eor=9, blank='zero', end=9, pad='no')
 
   !ERROR: If NML appears, REC must not appear
   !ERROR: If NML appears, FMT must not appear
   !ERROR: If NML appears, a data list must not appear
   write(10, nnn, rec=40, fmt=1) 'Ok'
 
-  !ERROR: Internal file variable 'const_internal_file' must be definable
+  !ERROR: Internal file variable 'const_internal_file' is not definable
+  !BECAUSE: '"(I6)"' is not a variable or pointer
   write(const_internal_file, fmt=*)
 
   !ERROR: If UNIT=* appears, POS must not appear
   write(*, pos=n, nml=nnn)
 
   !ERROR: If UNIT=* appears, REC must not appear
   write(*, rec=n)
 
! RUN: %python %S/test_errors.py %s %flang_fc1
 
   !ERROR: If DELIM appears, FMT=* or NML must also appear
   !ERROR: Invalid DELIM value 'Nix'
   write(delim='Nix', fmt='(A)', unit=10) 'Ok'
 
   !ERROR: ID kind (1) is smaller than default INTEGER kind (4)
   write(id=id1, unit=10, asynchronous='Yes') 'Ok'
 
-  !ERROR: ID variable 'const_id' must be definable
+  !ERROR: ID variable 'const_id' is not definable
+  !BECAUSE: '66666_4' is not a variable or pointer
   write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'
 
   write(*, '(X)')
 
   !ERROR: Output item must not be a procedure pointer
   print*, n1, procptr, n2
 
 1 format (A)
 9 continue
 end

flang/test/Semantics/io05.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
   inquire(1, read=c(1), write=c(2), sign=c(3), sign=c(4), read=c(5), write=c(1))
 
   !ERROR: Duplicate IOMSG specifier
   inquire(10, iomsg=msg, pos=ipos, iomsg=msg)
 
   !ERROR: If ID appears, PENDING must also appear
   inquire(file='abc', id=id)
 
-  !ERROR: ROUND variable 'const_round' must be definable
+  !ERROR: ROUND variable 'const_round' is not definable
+  !BECAUSE: '"c"' is not a variable or pointer
   inquire(file='abc', round=const_round)
 
 9 continue
 end

flang/test/Semantics/io06.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
   wait(99, id=id1, end=9, eor=9, err=9, iostat=stat1, iomsg=msg1)
 
   !ERROR: Duplicate UNIT specifier
   backspace(10, unit=11)
 
   !ERROR: Duplicate IOSTAT specifier
   endfile(iostat=stat2, err=9, unit=10, iostat=stat8, iomsg=msg1)
 
-  !ERROR: IOMSG variable 'const_msg' must be definable
+  !ERROR: IOMSG variable 'const_msg' is not definable
+  !BECAUSE: '"d"' is not a variable or pointer
   flush(iomsg=const_msg, unit=10, iostat=stat8, err=9)
 
   !ERROR: REWIND statement must have a UNIT number specifier
   rewind(iostat=stat2)
 
   !ERROR: Duplicate ERR specifier
   flush(err=9, unit=10, &
         err=9, &
         err=9)
 
   !ERROR: Duplicate ID specifier
   !ERROR: WAIT statement must have a UNIT number specifier
   wait(id=id2, eor=9, id=id3)
 
 9 continue
 end

flang/test/Semantics/modifiable01.f90

module m
   character(*), parameter :: internal = '0'
  contains
   subroutine test1(dummy)
     real :: arr(2)
     integer, parameter :: j3 = 666
     type(ptype), intent(in) :: dummy
     type(t2) :: t2var
     associate (a => 3+4)
-      !CHECK: error: Input variable 'a' must be definable
-      !CHECK: 'a' is construct associated with an expression
+      !CHECK: error: Input variable 'a' is not definable
+      !CHECK: because: 'a' is construct associated with an expression
       read(internal,*) a
     end associate
     associate (a => arr([1])) ! vector subscript
-      !CHECK: error: Input variable 'a' must be definable
-      !CHECK: Construct association has a vector subscript
+      !CHECK: error: Input variable 'a' is not definable
+      !CHECK: because: Construct association 'a' has a vector subscript
       read(internal,*) a
     end associate
     associate (a => arr(2:1:-1))
       read(internal,*) a ! ok
     end associate
-    !CHECK: error: Input variable 'j3' must be definable
-    !CHECK: '666_4' is not a variable
+    !CHECK: error: Input variable 'j3' is not definable
+    !CHECK: because: '666_4' is not a variable
     read(internal,*) j3
-    !CHECK: error: Left-hand side of assignment is not modifiable
-    !CHECK: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
+    !CHECK: error: Left-hand side of assignment is not definable
+    !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
     t2var = t2static
     t2var%x2 = 0. ! ok
-    !CHECK: error: Left-hand side of assignment is not modifiable
-    !CHECK: 'prot' is protected in this scope
+    !CHECK: error: Left-hand side of assignment is not definable
+    !CHECK: because: 'prot' is protected in this scope
     prot = 0.
     protptr%ptr = 0. ! ok
-    !CHECK: error: Left-hand side of assignment is not modifiable
-    !CHECK: 'dummy' is an INTENT(IN) dummy argument
+    !CHECK: error: Left-hand side of assignment is not definable
+    !CHECK: because: 'dummy' is an INTENT(IN) dummy argument
     dummy%x = 0.
     dummy%ptr = 0. ! ok
   end subroutine
   pure subroutine test2(ptr)
     integer, pointer, intent(in) :: ptr
-    !CHECK: error: Input variable 'ptr' must be definable
-    !CHECK: 'ptr' is externally visible and referenced in a pure procedure
+    !CHECK: error: Input variable 'ptr' is not definable
+    !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
     read(internal,*) ptr
   end subroutine
 end module

flang/test/Semantics/nullify02.f90

 End Type
 
 Type(t),Allocatable :: x(:)
 
 Integer :: pi
 Procedure(Real) :: prp
 
 Allocate(x(3))
-!ERROR: component in NULLIFY statement must have the POINTER attribute
+!ERROR: 'p' may not appear in NULLIFY
+!BECAUSE: 'p' is not a pointer
 Nullify(x(2)%p)
 
-!ERROR: name in NULLIFY statement must have the POINTER attribute
+!ERROR: 'pi' may not appear in NULLIFY
+!BECAUSE: 'pi' is not a pointer
 Nullify(pi)
 
-!ERROR: name in NULLIFY statement must be a variable or procedure pointer
+!ERROR: 'prp' may not appear in NULLIFY
+!BECAUSE: 'prp' is not a pointer
 Nullify(prp)
 
-!ERROR: name in NULLIFY statement must be a variable or procedure pointer
+!ERROR: 'maxvalue' may not appear in NULLIFY
+!BECAUSE: 'maxvalue' is not a pointer
 Nullify(maxvalue)
 
 End Program
 
 ! Make sure that the compiler doesn't crash when NULLIFY is used in a context
 ! that has reported errors
 module badNullify
   interface
     function ptrFun()
       integer, pointer :: ptrFun
     end function
   end interface
 contains
   !ERROR: 'ptrfun' was not declared a separate module procedure
   !ERROR: 'ptrfun' is already declared in this scoping unit
   module function ptrFun()
     integer, pointer :: ptrFun
     real :: realVar
     nullify(ptrFun)
-    !ERROR: name in NULLIFY statement must have the POINTER attribute
+    !ERROR: 'realvar' may not appear in NULLIFY
+    !BECAUSE: 'realvar' is not a pointer
     nullify(realVar)
   end function
 end module

flang/test/Semantics/random-seed.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! NULL() intrinsic function error tests
 program test_random_seed
   integer :: size_arg
   integer, parameter :: size_arg_const = 343
   integer, dimension(3), parameter :: put_arg = [9,8,7]
   integer  :: get_arg_scalar
   integer, dimension(3) :: get_arg
   integer, dimension(3),parameter :: get_arg_const = [8,7,6]
   call random_seed()
   call random_seed(size_arg)
   call random_seed(size=size_arg)
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'size=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'size=' is not definable
+  !BECAUSE: '343_4' is not a variable or pointer
   call random_seed(size_arg_const) ! error, size arg must be definable
   !ERROR: 'size=' argument has unacceptable rank 1
   call random_seed([1, 2, 3, 4]) ! Error, must be a scalar
   call random_seed(put = [1, 2, 3, 4])
   call random_seed(put = put_arg)
   !ERROR: 'size=' argument has unacceptable rank 1
   call random_seed(get_arg) ! Error, must be a scalar
   call random_seed(get=get_arg)
   !ERROR: 'get=' argument has unacceptable rank 0
   call random_seed(get=get_arg_scalar) ! Error, GET arg must be of rank 1
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'get=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'get=' is not definable
+  !BECAUSE: '[INTEGER(4)::8_4,7_4,6_4]' is not a variable or pointer
   call random_seed(get=get_arg_const) ! Error, GET arg must be definable
   !ERROR: RANDOM_SEED must have either 1 or no arguments
   call random_seed(size_arg, get_arg) ! Error, only 0 or 1 argument
 end program

flang/test/Semantics/resolve35.f90

 end
 
 subroutine s10
   external bad1
   real, parameter :: bad2 = 1.0
   x = cos(0.)
   do concurrent(i=1:2) &
     !ERROR: 'bad1' may not appear in a locality-spec because it is not definable
+    !BECAUSE: 'bad1' is not a variable
     local(bad1) &
     !ERROR: 'bad2' may not appear in a locality-spec because it is not definable
+    !BECAUSE: 'bad2' is not a variable
     local(bad2) &
     !ERROR: 'bad3' may not appear in a locality-spec because it is not definable
+    !BECAUSE: 'bad3' is not a variable
     local(bad3) &
     !ERROR: 'cos' may not appear in a locality-spec because it is not definable
+    !BECAUSE: 'cos' is not a variable
     local(cos)
   end do
   do concurrent(i=1:2) &
     !ERROR: The name 'bad1' must be a variable to appear in a locality-spec
     shared(bad1) &
     !ERROR: The name 'bad2' must be a variable to appear in a locality-spec
     shared(bad2) &
     !ERROR: The name 'bad3' must be a variable to appear in a locality-spec
     shared(bad3) &
     !ERROR: The name 'cos' must be a variable to appear in a locality-spec
     shared(cos)
   end do
 contains
   subroutine bad3
   end
 end

flang/test/Semantics/resolve57.f90

contains
     end subroutine sub
 endmodule m3
 
 subroutine s4()
   use m3
 
   ! C857 This is not OK because of the "protected" attribute
 !ERROR: 'prot' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'prot' is protected in this scope
   do concurrent (i=1:5) local(prot)
   end do
 
   ! C857 This is OK because of there's no "protected" attribute
   do concurrent (i=1:5) local(var)
   end do
 end subroutine s4
 
 subroutine s5()
   real :: a, b, c, d, e
 
   associate (a => b + c, d => e)
     b = 3.0
     ! C1101 This is OK because 'd' is associated with a variable
     do concurrent (i=1:5) local(d)
     end do
 
     ! C1101 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
+!BECAUSE: 'a' is construct associated with an expression
     do concurrent (i=1:5) local(a)
     end do
   end associate
 end subroutine s5
 
 subroutine s6()
   type point
     real :: x, y
type is ( point )
     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
+!BECAUSE: 'a' is construct associated with an expression
     do concurrent (i=1:5) local(a)
     end do
   end select
 
   contains
     function func()
       class(point), pointer :: func
       func => c
     end function func
 end subroutine s6
 
 module m4
   real, protected :: prot
   real var
 endmodule m4
 
 pure subroutine s7()
   use m4
 
   ! C1594 This is not OK because we're in a PURE subroutine
 !ERROR: 'var' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'var' may not be defined in pure subprogram 's7' because it is USE-associated
   do concurrent (i=1:5) local(var)
   end do
 end subroutine s7
 
 subroutine s8()
   integer, parameter :: iconst = 343
 
 !ERROR: 'iconst' may not appear in a locality-spec because it is not definable
+!BECAUSE: 'iconst' is not a variable
   do concurrent (i=1:5) local(iconst)
   end do
 end subroutine s8

flang/test/Semantics/resolve62.f90

 subroutine s4a
   use m4
   real :: z
   !OK
   call s(z)
 end
 subroutine s4b
   use m4
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+  !BECAUSE: 'x' is protected in this scope
   call s(x)
 end
 pure subroutine s4c
   use m4
-  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable
+  !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+  !BECAUSE: 'y' may not be defined in pure subprogram 's4c' because it is USE-associated
   call s(y)
 end

flang/test/Semantics/resolve76.f90

interface
     end
     logical module function f()
     end
   end interface
 end
 submodule(m1) sm1
 contains
   module procedure sub1
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'a' is an INTENT(IN) dummy argument
     a = 1.0
     b = 2.0
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types REAL(4) and LOGICAL(4)
     b = .false.
   end
   module procedure f
     f = .true.
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types LOGICAL(4) and REAL(4)
     f = 1.0
   end
 end

flang/test/Semantics/selecttype03.f90

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
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'y' is construct associated with an expression
     y%i = 1 !VDC
   type is (t2)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+    !BECAUSE: 'y' is construct associated with an expression
     call sub_with_in_and_inout_param(y,y) !VDC
 end select
 
 ! B) associated with a variable:
 p_or_c => x1
 select type ( a => p_or_c )
   type is (t1)
     a%i = 10
 end select
 
 select type ( a => p_or_c )
   type is (t1)
 end select
 
 !C)Associate with  with vector subscript
 select type (b => array1(V,2))
   type is (t1)
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: Construct association 'b' has a vector subscript
     b%i  = 1 !VDC
   type is (t2)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+    !BECAUSE: Variable 'b' has a vector subscript
     call sub_with_in_and_inout_param_vector(b,b) !VDC
 end select
 select type(b =>  foo(1) )
   type is (t1)
-    !ERROR: Left-hand side of assignment is not modifiable
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'b' is construct associated with an expression
     b%i = 1 !VDC
   type is (t2)
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
+    !BECAUSE: 'b' is construct associated with an expression
     call sub_with_in_and_inout_param_vector(b,b) !VDC
 end select
 
 !D) Have no association and should be ok.
 !1. points to function
 ptr => fun(1)
 select type ( ptr )
 type is (t1)