From d32d669651441ccb16069f404c230d13c426279b Mon Sep 17 00:00:00 2001 From: Pete Steinfeld Date: Thu, 2 Jan 2020 12:26:47 -0800 Subject: [PATCH] [flang] Check for passing DO variables to OUT arguments in a CALL statement I added code to save the INTENT of a dummy argument in the checked expression of the actual argument. When processing a CallStmt, I then retrieve the ProcedureRef, which contains a list of the checked ActualArguments. I then traverse this list looking for actual arguments that are active DO variable that are being passed to dummy arguments whose INTENT is either OUT or INOUT. For OUT dummies, I put out an error message and warn for INOUT dummies. Original-commit: flang-compiler/f18@0ff1d264284c51a0142df0b785eb5f6409e8ad51 Reviewed-on: https://github.com/flang-compiler/f18/pull/902 --- flang/lib/evaluate/call.h | 6 ++++ flang/lib/semantics/check-call.cc | 1 + flang/lib/semantics/check-do.cc | 48 +++++++++++++++++++++++++- flang/lib/semantics/check-do.h | 2 ++ flang/lib/semantics/check-io.cc | 2 +- flang/lib/semantics/semantics.cc | 33 +++++++++++------- flang/lib/semantics/semantics.h | 6 ++-- flang/test/semantics/dosemantics12.f90 | 38 ++++++++++++++++++++ 8 files changed, 119 insertions(+), 17 deletions(-) diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h index 2cc6bfa540f4..232297ef3519 100644 --- a/flang/lib/evaluate/call.h +++ b/flang/lib/evaluate/call.h @@ -111,6 +111,11 @@ public: void set_isPassedObject(bool yes = true) { isPassedObject_ = yes; } bool Matches(const characteristics::DummyArgument &) const; + common::Intent dummyIntent() const { return dummyIntent_; } + ActualArgument &set_dummyIntent(common::Intent intent) { + dummyIntent_ = intent; + return *this; + } // Wrap this argument in parentheses void Parenthesize(); @@ -127,6 +132,7 @@ private: std::optional keyword_; bool isAlternateReturn_{false}; // whether expr is a "*label" number bool isPassedObject_{false}; + common::Intent dummyIntent_{common::Intent::Default}; }; using ActualArguments = std::vector>; diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc index e92bbe3d573d..83f78dd6f13e 100644 --- a/flang/lib/semantics/check-call.cc +++ b/flang/lib/semantics/check-call.cc @@ -601,6 +601,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, if (auto *expr{arg.UnwrapExpr()}) { if (auto type{characteristics::TypeAndShape::Characterize( *expr, context)}) { + arg.set_dummyIntent(object.intent); bool isElemental{object.type.Rank() == 0 && proc.IsElemental()}; CheckExplicitDataArg(object, dummyName, *expr, *type, isElemental, IsArrayElement(*expr), context, scope); diff --git a/flang/lib/semantics/check-do.cc b/flang/lib/semantics/check-do.cc index 5d2aa2782579..288812e3715d 100644 --- a/flang/lib/semantics/check-do.cc +++ b/flang/lib/semantics/check-do.cc @@ -902,6 +902,52 @@ void DoChecker::Leave(const parser::AssignmentStmt &stmt) { context_.CheckDoVarRedefine(variable); } +// Check to see if a DO variable is being passed as an actual argument to a +// dummy argument whose intent is OUT or INOUT. To do this, we need to find +// the expressions for actual arguments which contain DO variables. We get the +// intents of the dummy arguments from the ProcedureRef in the "typedCall" +// field of the CallStmt which was filled in during expression checking. At +// the same time, we need to iterate over the parser::Expr versions of the +// actual arguments to get their source locations of the arguments for the +// messages. +void DoChecker::Leave(const parser::CallStmt &callStmt) { + if (const auto &typedCall{callStmt.typedCall}) { + const auto &parsedArgs{ + std::get>(callStmt.v.t)}; + auto parsedArgIter{parsedArgs.begin()}; + const evaluate::ActualArguments &checkedArgs{typedCall->arguments()}; + for (const auto &checkedOptionalArg : checkedArgs) { + if (parsedArgIter == parsedArgs.end()) { + break; // No more parsed arguments, we're done. + } + const auto &parsedArg{std::get(parsedArgIter->t)}; + ++parsedArgIter; + if (checkedOptionalArg) { + const evaluate::ActualArgument &checkedArg{*checkedOptionalArg}; + if (const SomeExpr * checkedExpr{checkedArg.UnwrapExpr()}) { + if (const Symbol * + variable{evaluate::UnwrapWholeSymbolDataRef(*checkedExpr)}) { + if (const auto *parsedExpr{ + std::get_if>( + &parsedArg.u)}) { + const parser::CharBlock location{parsedExpr->value().source}; + switch (checkedArg.dummyIntent()) { + case common::Intent::Out: + context_.CheckDoVarRedefine(location, *variable); + break; + case common::Intent::InOut: + context_.WarnDoVarRedefine(location, *variable); + break; + default:; // INTENT(IN) or default intent + } + } + } + } + } + } + } +} + void DoChecker::Leave(const parser::ConnectSpec &connectSpec) { const auto *newunit{ std::get_if(&connectSpec.u)}; @@ -928,7 +974,7 @@ void DoChecker::Leave(const parser::IoControlSpec &ioControlSpec) { void DoChecker::Leave(const parser::OutputImpliedDo &outputImpliedDo) { const auto &control{std::get(outputImpliedDo.t)}; const parser::Name &name{control.name.thing.thing}; - context_.CheckDoVarRedefine(*name.symbol, name.source); + context_.CheckDoVarRedefine(name.source, *name.symbol); } void DoChecker::Leave(const parser::StatVariable &statVariable) { diff --git a/flang/lib/semantics/check-do.h b/flang/lib/semantics/check-do.h index 7dc1f3cb72af..c584593b2779 100644 --- a/flang/lib/semantics/check-do.h +++ b/flang/lib/semantics/check-do.h @@ -14,6 +14,7 @@ namespace Fortran::parser { struct AssignmentStmt; +struct CallStmt; struct ConnectSpec; struct CycleStmt; struct DoConstruct; @@ -33,6 +34,7 @@ class DoChecker : public virtual BaseChecker { public: explicit DoChecker(SemanticsContext &context) : context_{context} {} void Leave(const parser::AssignmentStmt &); + void Leave(const parser::CallStmt &); void Leave(const parser::ConnectSpec &); void Enter(const parser::CycleStmt &); void Enter(const parser::DoConstruct &); diff --git a/flang/lib/semantics/check-io.cc b/flang/lib/semantics/check-io.cc index 796bfc31fcf7..3bd696d44c2a 100644 --- a/flang/lib/semantics/check-io.cc +++ b/flang/lib/semantics/check-io.cc @@ -509,7 +509,7 @@ static void CheckForDoVariableInNamelist(const Symbol &namelist, SemanticsContext &context, parser::CharBlock namelistLocation) { const auto &details{namelist.GetUltimate().get()}; for (const Symbol &object : details.objects()) { - context.CheckDoVarRedefine(object, namelistLocation); + context.CheckDoVarRedefine(namelistLocation, object); } } diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index eb6b57b008d4..4ab101036dfc 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -203,34 +203,41 @@ void SemanticsContext::PopConstruct() { constructStack_.pop_back(); } -void SemanticsContext::SayDoVarRedefine( +void SemanticsContext::CheckDoVarRedefine(const parser::CharBlock &location, + const Symbol &variable, parser::MessageFixedText &&message) { + if (const Symbol * root{GetAssociationRoot(variable)}) { + if (IsActiveDoVariable(*root)) { + parser::CharBlock doLoc{GetDoVariableLocation(*root)}; + CHECK(doLoc != parser::CharBlock{}); + Say(location, message, root->name()) + .Attach(doLoc, "Enclosing DO construct"_en_US); + } + } +} + +void SemanticsContext::WarnDoVarRedefine( const parser::CharBlock &location, const Symbol &variable) { - const parser::CharBlock doLoc{GetDoVariableLocation(variable)}; - CHECK(doLoc != parser::CharBlock{}); - Say(location, "Cannot redefine DO variable '%s'"_err_en_US, variable.name()) - .Attach(doLoc, "Enclosing DO construct"_en_US); + CheckDoVarRedefine(location, variable, + std::move("Possible redefinition of DO variable '%s'"_en_US)); } void SemanticsContext::CheckDoVarRedefine( - const Symbol &variable, const parser::CharBlock &location) { - if (const Symbol * root{GetAssociationRoot(variable)}) { - if (IsActiveDoVariable(*root)) { - SayDoVarRedefine(location, *root); - } - } + const parser::CharBlock &location, const Symbol &variable) { + CheckDoVarRedefine(location, variable, + std::move("Cannot redefine DO variable '%s'"_err_en_US)); } void SemanticsContext::CheckDoVarRedefine(const parser::Variable &variable) { if (const Symbol * entity{GetLastName(variable).symbol}) { const parser::CharBlock &sourceLocation{variable.GetSource()}; - CheckDoVarRedefine(*entity, sourceLocation); + CheckDoVarRedefine(sourceLocation, *entity); } } void SemanticsContext::CheckDoVarRedefine(const parser::Name &name) { const parser::CharBlock &sourceLocation{name.source}; if (const Symbol * entity{name.symbol}) { - CheckDoVarRedefine(*entity, sourceLocation); + CheckDoVarRedefine(sourceLocation, *entity); } } diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h index 8de61b9f04ae..cac82650d994 100644 --- a/flang/lib/semantics/semantics.h +++ b/flang/lib/semantics/semantics.h @@ -152,7 +152,8 @@ public: // Check to see if a variable being redefined is a DO variable. If so, emit // a message - void CheckDoVarRedefine(const Symbol &, const parser::CharBlock &); + void WarnDoVarRedefine(const parser::CharBlock &, const Symbol &); + void CheckDoVarRedefine(const parser::CharBlock &, const Symbol &); void CheckDoVarRedefine(const parser::Variable &); void CheckDoVarRedefine(const parser::Name &); void ActivateDoVariable(const parser::Name &); @@ -161,7 +162,8 @@ public: private: parser::CharBlock GetDoVariableLocation(const Symbol &); - void SayDoVarRedefine(const parser::CharBlock &, const Symbol &); + void CheckDoVarRedefine( + const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&); const common::IntrinsicTypeDefaultKinds &defaultKinds_; const common::LanguageFeatureControl languageFeatures_; parser::AllSources &allSources_; diff --git a/flang/test/semantics/dosemantics12.f90 b/flang/test/semantics/dosemantics12.f90 index 3e62574f9c1b..54566093eb3b 100644 --- a/flang/test/semantics/dosemantics12.f90 +++ b/flang/test/semantics/dosemantics12.f90 @@ -373,3 +373,41 @@ subroutine s11() end do end subroutine s11 + +subroutine s12() + + Integer :: ivar, jvar + + call intentInSub(jvar, ivar) + do ivar = 1,10 + call intentInSub(jvar, ivar) + end do + + call intentOutSub(jvar, ivar) + do ivar = 1,10 +!ERROR: Cannot redefine DO variable 'ivar' + call intentOutSub(jvar, ivar) + end do + + call intentInOutSub(jvar, ivar) + do ivar = 1,10 + call intentInOutSub(jvar, ivar) + end do + +contains + subroutine intentInSub(arg1, arg2) + integer, intent(in) :: arg1 + integer, intent(in) :: arg2 + end subroutine intentInSub + + subroutine intentOutSub(arg1, arg2) + integer, intent(in) :: arg1 + integer, intent(out) :: arg2 + end subroutine intentOutSub + + subroutine intentInOutSub(arg1, arg2) + integer, intent(in) :: arg1 + integer, intent(inout) :: arg2 + end subroutine intentInOutSub + +end subroutine s12