From d022fc1ccad62498723ac9f12563fa71cbef29ce Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 10 Oct 2019 13:09:35 -0700 Subject: [PATCH] [flang] definability tests Original-commit: flang-compiler/f18@4b71f003a9c3a88b4a3e5cbad12f33fb46ef0657 Reviewed-on: https://github.com/flang-compiler/f18/pull/782 Tree-same-pre-rewrite: false --- flang/lib/evaluate/tools.cc | 16 +++++++++ flang/lib/evaluate/tools.h | 11 +++++++ flang/lib/parser/message.cc | 4 +++ flang/lib/parser/message.h | 3 +- flang/lib/semantics/check-call.cc | 69 ++++++++++++++++++++++++++------------- flang/lib/semantics/check-call.h | 4 ++- flang/lib/semantics/expression.cc | 4 +-- flang/lib/semantics/tools.cc | 36 +++++++++++++++++--- flang/lib/semantics/tools.h | 4 ++- flang/test/semantics/call03.f90 | 10 +++--- 10 files changed, 125 insertions(+), 36 deletions(-) diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc index a73466a..33dcfa7 100644 --- a/flang/lib/evaluate/tools.cc +++ b/flang/lib/evaluate/tools.cc @@ -734,4 +734,20 @@ template SetOfSymbols CollectSymbols(const Expr &); template SetOfSymbols CollectSymbols(const Expr &); template SetOfSymbols CollectSymbols(const Expr &); +// HasVectorSubscript() +struct HasVectorSubscriptHelper : public AnyTraverse { + using Base = AnyTraverse; + HasVectorSubscriptHelper() : Base{*this} {} + using Base::operator(); + bool operator()(const Subscript &ss) const { + return !std::holds_alternative(ss.u) && ss.Rank() > 0; + } + bool operator()(const ProcedureRef &) const { + return false; // don't descend into function call arguments + } +}; + +bool HasVectorSubscript(const Expr &expr) { + return HasVectorSubscriptHelper{}(expr); +} } diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h index 9755616..f2d9331 100644 --- a/flang/lib/evaluate/tools.h +++ b/flang/lib/evaluate/tools.h @@ -303,6 +303,14 @@ template const Symbol *UnwrapWholeSymbolDataRef(const A &x) { return nullptr; } +template const Symbol *GetFirstSymbol(const A &x) { + if (auto dataRef{ExtractDataRef(x)}) { + return &dataRef->GetFirstSymbol(); + } else { + return nullptr; + } +} + // Creation of conversion expressions can be done to either a known // specific intrinsic type with ConvertToType(x) or by converting // one arbitrary expression to the type of another with ConvertTo(to, from). @@ -788,5 +796,8 @@ template SetOfSymbols CollectSymbols(const A &); extern template SetOfSymbols CollectSymbols(const Expr &); extern template SetOfSymbols CollectSymbols(const Expr &); extern template SetOfSymbols CollectSymbols(const Expr &); + +// Predicate: does a variable contain a vector-valued subscript (not a triplet)? +bool HasVectorSubscript(const Expr &); } #endif // FORTRAN_EVALUATE_TOOLS_H_ diff --git a/flang/lib/parser/message.cc b/flang/lib/parser/message.cc index 6096f66..d53ffdc 100644 --- a/flang/lib/parser/message.cc +++ b/flang/lib/parser/message.cc @@ -256,6 +256,10 @@ Message &Message::Attach(Message *m) { return *this; } +Message &Message::Attach(std::unique_ptr &&m) { + return Attach(m.release()); +} + bool Message::AtSameLocation(const Message &that) const { return std::visit( common::visitors{ diff --git a/flang/lib/parser/message.h b/flang/lib/parser/message.h index dc7d9b2..2efd6d8 100644 --- a/flang/lib/parser/message.h +++ b/flang/lib/parser/message.h @@ -87,7 +87,7 @@ public: std::string MoveString() { return std::move(string_); } private: - void Format(const MessageFixedText *text, ...); + void Format(const MessageFixedText *, ...); template A Convert(const A &x) { static_assert(!std::is_class_v>); @@ -185,6 +185,7 @@ public: attachmentIsContext_ = true; } Message &Attach(Message *); + Message &Attach(std::unique_ptr &&); template Message &Attach(A &&... args) { return Attach(new Message{std::forward(args)...}); // reference-counted } diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc index 3c363da..e715644 100644 --- a/flang/lib/semantics/check-call.cc +++ b/flang/lib/semantics/check-call.cc @@ -112,7 +112,7 @@ static void InspectType( static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, const evaluate::Expr &actual, const characteristics::TypeAndShape &actualType, - parser::ContextualMessages &messages) { + parser::ContextualMessages &messages, const Scope &scope) { dummy.type.IsCompatibleWith(messages, actualType); bool actualIsPolymorphic{actualType.type().IsPolymorphic()}; bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()}; @@ -212,12 +212,35 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "Element of assumed-shape array may not be associated with a dummy argument array"_err_en_US); } } + const char *reason{nullptr}; + if (dummy.intent == common::Intent::Out) { + reason = "INTENT(OUT)"; + } else if (dummy.intent == common::Intent::InOut) { + reason = "INTENT(IN OUT)"; + } else if (dummy.attrs.test( + characteristics::DummyDataObject::Attr::Asynchronous)) { + reason = "ASYNCHRONOUS"; + } else if (dummy.attrs.test( + characteristics::DummyDataObject::Attr::Volatile)) { + reason = "VOLATILE"; + } + if (reason != nullptr) { + std::unique_ptr why{ + WhyNotModifiable(messages.at(), actual, scope)}; + if (why.get() != nullptr) { + if (auto *msg{messages.Say( + "Actual argument associated with %s dummy must be definable"_err_en_US, + reason)}) { + msg->Attach(std::move(why)); + } + } + } // TODO pmk more here } static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg, const characteristics::DummyArgument &dummy, - evaluate::FoldingContext &context) { + evaluate::FoldingContext &context, const Scope &scope) { auto &messages{context.messages()}; std::visit( common::visitors{ @@ -225,7 +248,8 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg, if (const auto *expr{arg.UnwrapExpr()}) { if (auto type{characteristics::TypeAndShape::Characterize( *expr, context)}) { - CheckExplicitDataArg(object, *expr, *type, context.messages()); + CheckExplicitDataArg( + object, *expr, *type, context.messages(), scope); } else if (object.type.type().IsTypelessIntrinsicArgument() && std::holds_alternative( expr->u)) { @@ -316,7 +340,7 @@ static void RearrangeArguments(const characteristics::Procedure &proc, } bool CheckExplicitInterface(const characteristics::Procedure &proc, - ActualArguments &actuals, FoldingContext &context) { + ActualArguments &actuals, FoldingContext &context, const Scope &scope) { if (!RearrangeArguments(proc, actuals, context.messages())) { return false; } @@ -324,19 +348,19 @@ bool CheckExplicitInterface(const characteristics::Procedure &proc, for (auto &actual : actuals) { const auto &dummy{proc.dummyArguments[index++]}; if (actual.has_value()) { - if (!CheckExplicitInterfaceArg(*actual, dummy, context)) { + if (!CheckExplicitInterfaceArg(*actual, dummy, context, scope)) { return false; } } else if (!dummy.IsOptional()) { if (dummy.name.empty()) { context.messages().Say( "Dummy argument #%d is not OPTIONAL and is not associated with an " - "effective argument in this procedure reference"_err_en_US, + "actual argument in this procedure reference"_err_en_US, index); } else { context.messages().Say( "Dummy argument '%s' (#%d) is not OPTIONAL and is not associated " - "with an effective argument in this procedure reference"_err_en_US, + "with an actual argument in this procedure reference"_err_en_US, dummy.name, index); } return false; @@ -347,27 +371,28 @@ bool CheckExplicitInterface(const characteristics::Procedure &proc, void CheckArguments(const characteristics::Procedure &proc, evaluate::ActualArguments &actuals, evaluate::FoldingContext &context, - bool treatingExternalAsImplicit) { - parser::Messages buffer; - parser::ContextualMessages messages{context.messages().at(), &buffer}; - if (proc.HasExplicitInterface() && !treatingExternalAsImplicit) { - evaluate::FoldingContext localContext{context, messages}; - CheckExplicitInterface(proc, actuals, localContext); - } else { + const Scope &scope, bool treatingExternalAsImplicit) { + bool explicitInterface{proc.HasExplicitInterface()}; + if (explicitInterface()) { + CheckExplicitInterface(proc, actuals, context, scope); + } + if (!explicitInterface || treatingExternalAsImplicit) { + parser::Messages buffer; + parser::ContextualMessages messages{context.messages().at(), &buffer}; for (auto &actual : actuals) { if (actual.has_value()) { CheckImplicitInterfaceArg(*actual, messages); } } - } - if (!buffer.empty()) { - if (treatingExternalAsImplicit) { - if (auto *msg{context.messages().Say( - "Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) { - buffer.AttachTo(*msg); + if (!buffer.empty()) { + if (treatingExternalAsImplicit) { + if (auto *msg{context.messages().Say( + "Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) { + buffer.AttachTo(*msg); + } + } else if (auto *msgs{context.messages().messages()}) { + msgs->Merge(std::move(buffer)); } - } else if (auto *msgs{context.messages().messages()}) { - msgs->Merge(std::move(buffer)); } } } diff --git a/flang/lib/semantics/check-call.h b/flang/lib/semantics/check-call.h index d94f937..bd1616f 100644 --- a/flang/lib/semantics/check-call.h +++ b/flang/lib/semantics/check-call.h @@ -30,12 +30,14 @@ class FoldingContext; } namespace Fortran::semantics { +class Scope; + // The Boolean flag argument should be true when the called procedure // does not actually have an explicit interface at the call site, but // its characteristics are known because it is a subroutine or function // defined at the top level in the same source file. void CheckArguments(const evaluate::characteristics::Procedure &, - evaluate::ActualArguments &, evaluate::FoldingContext &, + evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &, bool treatingExternalAsImplicit = false); // Check actual arguments against a procedure with an explicit interface. diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 70a7ff7..0e40fbc 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1800,8 +1800,8 @@ std::optional ExpressionAnalyzer::CheckCall( "References to the procedure '%s' require an explicit interface"_en_US, DEREF(proc.GetSymbol()).name()); } - semantics::CheckArguments( - *chars, arguments, GetFoldingContext(), treatExternalAsImplicit); + semantics::CheckArguments(*chars, arguments, GetFoldingContext(), + context_.FindScope(callSite), treatExternalAsImplicit); } return chars; } diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index 2752ea2..8b4662f 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -331,10 +331,14 @@ const Symbol *FindFunctionResult(const Symbol &symbol) { return nullptr; } +// When an construct association maps to a variable, and that variable +// is not an array with a vector-valued subscript, return the base +// Symbol of that variable, else nullptr. Descends into other construct +// associations when one associations maps to another. static const Symbol *GetAssociatedVariable(const AssocEntityDetails &details) { if (const MaybeExpr & expr{details.expr()}) { - if (evaluate::IsVariable(*expr)) { - if (const Symbol * varSymbol{evaluate::GetLastSymbol(*expr)}) { + if (evaluate::IsVariable(*expr) && !evaluate::HasVectorSubscript(*expr)) { + if (const Symbol * varSymbol{evaluate::GetFirstSymbol(*expr)}) { return GetAssociationRoot(*varSymbol); } } @@ -485,8 +489,7 @@ bool InProtectedContext(const Symbol &symbol, const Scope ¤tScope) { } // C1101 and C1158 -// TODO Need to check for the case of a variable that has a vector subscript -// that is construct associated, also need to check for a coindexed object +// TODO Need to check for a coindexed object (why? C1103?) std::optional WhyNotModifiable( const Symbol &symbol, const Scope &scope) { const Symbol *root{GetAssociationRoot(symbol)}; @@ -508,6 +511,31 @@ std::optional WhyNotModifiable( } } +std::unique_ptr WhyNotModifiable( + parser::CharBlock at, const SomeExpr &expr, const Scope &scope) { + if (evaluate::IsVariable(expr)) { + if (auto dataRef{evaluate::ExtractDataRef(expr)}) { + if (evaluate::HasVectorSubscript(expr)) { + return std::make_unique( + at, "variable has a vector subscript"_en_US); + } else { + const Symbol &symbol{dataRef->GetFirstSymbol()}; + if (auto maybeWhy{WhyNotModifiable(symbol, scope)}) { + return std::make_unique(symbol.name(), + parser::MessageFormattedText{ + std::move(*maybeWhy), symbol.name()}); + } + } + } else { + // reference to function returning POINTER + } + } else { + return std::make_unique( + at, "expression is not a variable"_en_US); + } + return {}; +} + static const DeclTypeSpec &InstantiateIntrinsicType(Scope &scope, const DeclTypeSpec &spec, SemanticsContext &semanticsContext) { const IntrinsicTypeSpec *intrinsic{spec.AsIntrinsic()}; diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index ca8044b..80ae04d 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -114,7 +114,9 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) { bool IsAssumedLengthCharacter(const Symbol &); bool IsAssumedLengthCharacterFunction(const Symbol &); std::optional WhyNotModifiable( - const Symbol &symbol, const Scope &scope); + const Symbol &, const Scope &); +std::unique_ptr WhyNotModifiable( + SourceName, const SomeExpr &, const Scope &); // Is the symbol modifiable in this scope bool IsExternalInPureContext(const Symbol &symbol, const Scope &scope); diff --git a/flang/test/semantics/call03.f90 b/flang/test/semantics/call03.f90 index e66b78fe..c6c63bc 100644 --- a/flang/test/semantics/call03.f90 +++ b/flang/test/semantics/call03.f90 @@ -194,10 +194,10 @@ module m01 call intentout(3.14159) !ERROR: Actual argument associated with INTENT(OUT) dummy must be definable call intentout(in + 1.) - !ERROR: Actual argument associated with INTENT(OUT) dummy must be definable call intentout(x) ! ok !ERROR: Actual argument associated with INTENT(OUT) dummy must be definable call intentout((x)) + !ERROR: Actual argument associated with INTENT(IN OUT) dummy must be definable call intentinout(in) !ERROR: Actual argument associated with INTENT(IN OUT) dummy must be definable call intentinout(3.14159) @@ -212,13 +212,13 @@ module m01 real :: a(1) integer :: j(1) j(1) = 1 - !ERROR: array section with vector subscript cannot be associated with a dummy argument that must be definable + !ERROR: Actual argument associated with INTENT(OUT) dummy must be definable call intentout(a(j)) - !ERROR: array section with vector subscript cannot be associated with a dummy argument that must be definable + !ERROR: Actual argument associated with INTENT(IN OUT) dummy must be definable call intentinout(a(j)) - !ERROR: array section with vector subscript cannot be associated with a dummy argument that must be definable + !ERROR: Actual argument associated with ASYNCHRONOUS dummy must be definable call asynchronous(a(j)) - !ERROR: array section with vector subscript cannot be associated with a dummy argument that must be definable + !ERROR: Actual argument associated with VOLATILE dummy must be definable call volatile(a(j)) end subroutine -- 2.7.4