diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -175,8 +175,7 @@ bool IsExternal(const Symbol &); bool IsModuleProcedure(const Symbol &); // Is the symbol modifiable in this scope -std::optional WhyNotModifiable( - const Symbol &, const Scope &); +std::optional WhyNotModifiable(const Symbol &, const Scope &); std::optional WhyNotModifiable(SourceName, const SomeExpr &, const Scope &, bool vectorSubscriptIsOk = false); const Symbol *IsExternalInPureContext(const Symbol &, const Scope &); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1901,10 +1901,12 @@ } if (auto msg{ WhyNotModifiable(*symbol, context_.FindScope(name->source))}) { - context_.Say(GetContext().clauseSource, - "Variable '%s' on the %s clause is not definable"_err_en_US, - symbol->name(), - parser::ToUpperCaseLetters(getClauseName(clause).str())); + context_ + .Say(GetContext().clauseSource, + "Variable '%s' on the %s clause is not definable"_err_en_US, + symbol->name(), + parser::ToUpperCaseLetters(getClauseName(clause).str())) + .Attach(std::move(*msg)); } } } @@ -2473,7 +2475,7 @@ "Variable '%s' on the %s clause is not definable"_err_en_US, symbol->name(), parser::ToUpperCaseLetters(getClauseName(clause).str())) - .Attach(source, std::move(*msg), symbol->name()); + .Attach(std::move(*msg)); } } } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -523,7 +523,7 @@ void SayAlreadyDeclared(const SourceName &, Symbol &); void SayAlreadyDeclared(const SourceName &, const SourceName &); void SayWithReason( - const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&); + const parser::Name &, Symbol &, MessageFixedText &&, Message &&); void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&); void SayLocalMustBeVariable(const parser::Name &, Symbol &); void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &); @@ -2056,16 +2056,20 @@ } void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol, - MessageFixedText &&msg1, MessageFixedText &&msg2) { - Say2(name, std::move(msg1), symbol, std::move(msg2)); + MessageFixedText &&msg1, Message &&msg2) { + Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2)); context().SetError(symbol, msg1.isFatal()); } void ScopeHandler::SayWithDecl( const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) { - SayWithReason(name, symbol, std::move(msg), - symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US - : "Declaration of '%s'"_en_US); + Say(name, std::move(msg), symbol.name()) + .Attach(Message{name.source, + symbol.test(Symbol::Flag::Implicit) + ? "Implicit declaration of '%s'"_en_US + : "Declaration of '%s'"_en_US, + name.source}); + context().SetError(symbol, msg.isFatal()); } void ScopeHandler::SayLocalMustBeVariable( @@ -5379,8 +5383,7 @@ "Assumed size array '%s' not allowed in a locality-spec"_err_en_US); return false; } - if (std::optional msg{ - WhyNotModifiable(symbol, currScope())}) { + if (std::optional msg{WhyNotModifiable(symbol, currScope())}) { SayWithReason(name, symbol, "'%s' may not appear in a locality-spec because it is not " "definable"_err_en_US, diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -773,25 +773,42 @@ // C1101 and C1158 // Modifiability checks on the leftmost symbol ("base object") // of a data-ref -std::optional WhyNotModifiableFirst( - const Symbol &symbol, const Scope &scope) { - if (symbol.has()) { - return "'%s' is construct associated with an expression"_en_US; +static std::optional WhyNotModifiableFirst( + parser::CharBlock at, const Symbol &symbol, const Scope &scope) { + if (const auto *assoc{symbol.detailsIf()}) { + if (assoc->rank().has_value()) { + return std::nullopt; // SELECT RANK always modifiable variable + } else if (IsVariable(assoc->expr())) { + if (evaluate::HasVectorSubscript(assoc->expr().value())) { + return parser::Message{ + at, "Construct association has a vector subscript"_en_US}; + } else { + return WhyNotModifiable(at, *assoc->expr(), scope); + } + } else { + return parser::Message{at, + "'%s' is construct associated with an expression"_en_US, + symbol.name()}; + } } else if (IsExternalInPureContext(symbol, scope)) { - return "'%s' is externally visible and referenced in a pure" - " procedure"_en_US; + return parser::Message{at, + "'%s' is externally visible and referenced in a pure" + " procedure"_en_US, + symbol.name()}; } else if (!IsVariableName(symbol)) { - return "'%s' is not a variable"_en_US; + return parser::Message{at, "'%s' is not a variable"_en_US, symbol.name()}; } else { return std::nullopt; } } // Modifiability checks on the rightmost symbol of a data-ref -std::optional WhyNotModifiableLast( - const Symbol &symbol, const Scope &scope) { +static std::optional WhyNotModifiableLast( + parser::CharBlock at, const Symbol &symbol, const Scope &scope) { if (IsOrContainsEventOrLockComponent(symbol)) { - return "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US; + return parser::Message{at, + "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US, + symbol.name()}; } else { return std::nullopt; } @@ -800,27 +817,29 @@ // Modifiability checks on the leftmost (base) symbol of a data-ref // that apply only when there are no pointer components or a base // that is a pointer. -std::optional WhyNotModifiableIfNoPtr( - const Symbol &symbol, const Scope &scope) { +static std::optional WhyNotModifiableIfNoPtr( + parser::CharBlock at, const Symbol &symbol, const Scope &scope) { if (InProtectedContext(symbol, scope)) { - return "'%s' is protected in this scope"_en_US; + return parser::Message{ + at, "'%s' is protected in this scope"_en_US, symbol.name()}; } else if (IsIntentIn(symbol)) { - return "'%s' is an INTENT(IN) dummy argument"_en_US; + return parser::Message{ + at, "'%s' is an INTENT(IN) dummy argument"_en_US, symbol.name()}; } else { return std::nullopt; } } // Apply all modifiability checks to a single symbol -std::optional WhyNotModifiable( +std::optional WhyNotModifiable( const Symbol &original, const Scope &scope) { const Symbol &symbol{GetAssociationRoot(original)}; - if (auto first{WhyNotModifiableFirst(symbol, scope)}) { + if (auto first{WhyNotModifiableFirst(symbol.name(), symbol, scope)}) { return first; - } else if (auto last{WhyNotModifiableLast(symbol, scope)}) { + } else if (auto last{WhyNotModifiableLast(symbol.name(), symbol, scope)}) { return last; } else if (!IsPointer(symbol)) { - return WhyNotModifiableIfNoPtr(symbol, scope); + return WhyNotModifiableIfNoPtr(symbol.name(), symbol, scope); } else { return std::nullopt; } @@ -834,21 +853,16 @@ return parser::Message{at, "Variable has a vector subscript"_en_US}; } const Symbol &first{GetAssociationRoot(dataRef->GetFirstSymbol())}; - if (auto maybeWhyFirst{WhyNotModifiableFirst(first, scope)}) { - return parser::Message{first.name(), - parser::MessageFormattedText{ - std::move(*maybeWhyFirst), first.name()}}; + if (auto maybeWhyFirst{WhyNotModifiableFirst(at, first, scope)}) { + return maybeWhyFirst; } const Symbol &last{dataRef->GetLastSymbol()}; - if (auto maybeWhyLast{WhyNotModifiableLast(last, scope)}) { - return parser::Message{last.name(), - parser::MessageFormattedText{std::move(*maybeWhyLast), last.name()}}; + if (auto maybeWhyLast{WhyNotModifiableLast(at, last, scope)}) { + return maybeWhyLast; } if (!GetLastPointerSymbol(*dataRef)) { - if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(first, scope)}) { - return parser::Message{first.name(), - parser::MessageFormattedText{ - std::move(*maybeWhyFirst), first.name()}}; + if (auto maybeWhyFirst{WhyNotModifiableIfNoPtr(at, first, scope)}) { + return maybeWhyFirst; } } } else if (!evaluate::IsVariable(expr)) { diff --git a/flang/test/Semantics/modifiable01.f90 b/flang/test/Semantics/modifiable01.f90 --- a/flang/test/Semantics/modifiable01.f90 +++ b/flang/test/Semantics/modifiable01.f90 @@ -39,7 +39,7 @@ end associate associate (a => arr([1])) ! vector subscript !CHECK: error: Input variable 'a' must be definable - !CHECK: 'a' is construct associated with an expression + !CHECK: Construct association has a vector subscript read(internal,*) a end associate associate (a => arr(2:1:-1)) diff --git a/flang/test/Semantics/resolve57.f90 b/flang/test/Semantics/resolve57.f90 --- a/flang/test/Semantics/resolve57.f90 +++ b/flang/test/Semantics/resolve57.f90 @@ -85,6 +85,13 @@ end select select type ( a => func() ) + type is ( point ) + ! C1158 This is OK because 'a' is associated with a variable + do concurrent (i=1:5) local(a) + end do + end select + + select type ( a => (func()) ) type is ( point ) ! C1158 This is not OK because 'a' is not associated with a variable !ERROR: 'a' may not appear in a locality-spec because it is not definable diff --git a/flang/test/Semantics/selecttype03.f90 b/flang/test/Semantics/selecttype03.f90 --- a/flang/test/Semantics/selecttype03.f90 +++ b/flang/test/Semantics/selecttype03.f90 @@ -29,6 +29,13 @@ end select select type ( y => fun(1) ) + type is (t1) + y%i = 1 !VDC + type is (t2) + call sub_with_in_and_inout_param(y,y) !VDC +end select + +select type ( y => (fun(1)) ) type is (t1) !ERROR: Left-hand side of assignment is not modifiable y%i = 1 !VDC