[flang-commits] [flang] 458d9fb - [flang] Catch more bad TARGET= arguments to ASSOCIATED()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 8 11:44:12 PDT 2023
Author: Peter Klausler
Date: 2023-08-08T11:44:04-07:00
New Revision: 458d9fbdc7f76dd5167f90201f890f93ab0c5a25
URL: https://github.com/llvm/llvm-project/commit/458d9fbdc7f76dd5167f90201f890f93ab0c5a25
DIFF: https://github.com/llvm/llvm-project/commit/458d9fbdc7f76dd5167f90201f890f93ab0c5a25.diff
LOG: [flang] Catch more bad TARGET= arguments to ASSOCIATED()
The TARGET= argument to the intrinsic function ASSOCIATED() must be
a valid target for the POINTER= argument, but we are missing some
cases, such as parenthesized expressions. Add more checking, and
restructure the logic a bit to make the case analysis structure
more clear.
Fixes llvm-test-suite/Fortran/gfortran/regression/associated_target_1.f90.
Differential Revision: https://reviews.llvm.org/D157341
Added:
Modified:
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/associated.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 9db0563d73ba7d..302694c2a3ca62 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1252,95 +1252,91 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
}
}
}
- const auto *targetExpr{targetArg->UnwrapExpr()};
- if (targetExpr && pointerSymbol) {
- std::optional<characteristics::Procedure> pointerProc, targetProc;
- const auto *targetProcDesignator{
- evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(*targetExpr)};
- const Symbol *targetSymbol{GetLastSymbol(*targetExpr)};
- bool isCall{false};
- std::string targetName;
- if (const auto *targetProcRef{// target is a function call
- std::get_if<evaluate::ProcedureRef>(&targetExpr->u)}) {
- if (auto targetRefedChars{characteristics::Procedure::Characterize(
- *targetProcRef, context)}) {
- targetProc = *targetRefedChars;
- targetName = targetProcRef->proc().GetName() + "()";
- isCall = true;
- }
- } else if (targetProcDesignator) {
- targetProc = characteristics::Procedure::Characterize(
- *targetProcDesignator, context);
- targetName = targetProcDesignator->GetName();
- } else if (targetSymbol) {
- if (IsProcedure(*targetSymbol)) {
- // proc that's not a call
- targetProc = characteristics::Procedure::Characterize(
- *targetSymbol, context);
- }
- targetName = targetSymbol->name().ToString();
- }
- if (pointerSymbol && IsProcedure(*pointerSymbol)) {
- pointerProc = characteristics::Procedure::Characterize(
- *pointerSymbol, context);
- }
- if (pointerProc) {
- if (targetProc) {
- // procedure pointer and procedure target
- std::string whyNot;
- const evaluate::SpecificIntrinsic *specificIntrinsic{nullptr};
- if (targetProcDesignator) {
- specificIntrinsic =
- targetProcDesignator->GetSpecificIntrinsic();
+ if (const auto *targetExpr{targetArg->UnwrapExpr()};
+ targetExpr && pointerSymbol) {
+ if (IsProcedure(*pointerSymbol)) {
+ if (auto pointerProc{characteristics::Procedure::Characterize(
+ *pointerSymbol, context)}) {
+ // Characterize the target procedure
+ std::optional<characteristics::Procedure> targetProc;
+ const auto *targetProcDesignator{
+ evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(
+ *targetExpr)};
+ bool isCall{false};
+ std::string targetName;
+ if (IsProcedure(*targetExpr) ||
+ IsNullProcedurePointer(*targetExpr)) {
+ if (const auto *targetProcRef{
+ std::get_if<evaluate::ProcedureRef>(&targetExpr->u)}) {
+ // target is a function call returning a procedure pointer
+ targetProc = characteristics::Procedure::Characterize(
+ *targetProcRef, context);
+ isCall = true;
+ targetName = targetProcRef->proc().GetName() + "()";
+ } else if (targetProcDesignator) {
+ targetProc = characteristics::Procedure::Characterize(
+ *targetProcDesignator, context);
+ targetName = targetProcDesignator->GetName();
+ } else if (const Symbol * targSym{GetLastSymbol(*targetExpr)}) {
+ targetProc = characteristics::Procedure::Characterize(
+ *targSym, context);
+ targetName = targSym->name().ToString();
+ }
}
- if (std::optional<parser::MessageFixedText> msg{
- CheckProcCompatibility(isCall, pointerProc, &*targetProc,
- specificIntrinsic, whyNot)}) {
- msg->set_severity(parser::Severity::Warning);
+ if (targetProc) {
+ std::string whyNot;
+ const evaluate::SpecificIntrinsic *specificIntrinsic{
+ targetProcDesignator
+ ? targetProcDesignator->GetSpecificIntrinsic()
+ : nullptr};
+ if (std::optional<parser::MessageFixedText> msg{
+ CheckProcCompatibility(isCall, pointerProc,
+ &*targetProc, specificIntrinsic, whyNot)}) {
+ msg->set_severity(parser::Severity::Warning);
+ evaluate::AttachDeclaration(
+ context.messages().Say(std::move(*msg),
+ "pointer '" + pointerSymbol->name().ToString() + "'",
+ targetName, whyNot),
+ *pointerSymbol);
+ }
+ } else if (!IsNullProcedurePointer(*targetExpr)) {
evaluate::AttachDeclaration(
- context.messages().Say(std::move(*msg),
- "pointer '" + pointerSymbol->name().ToString() + "'",
- targetName, whyNot),
+ context.messages().Say(
+ "POINTER= argument '%s' is a procedure pointer but the TARGET= argument '%s' is not a procedure or procedure pointer"_err_en_US,
+ pointerSymbol->name(), targetExpr->AsFortran()),
*pointerSymbol);
}
- } else if (!IsNullProcedurePointer(*targetExpr)) {
- // procedure pointer and object target
- evaluate::AttachDeclaration(
- context.messages().Say(
- "POINTER= argument '%s' is a procedure pointer but the TARGET= argument '%s' is not a procedure or procedure pointer"_err_en_US,
- pointerSymbol->name(), targetName),
- *pointerSymbol);
}
- } else if (targetProc) {
- // object pointer and procedure target
- evaluate::AttachDeclaration(
- context.messages().Say(
- "POINTER= argument '%s' is an object pointer but the TARGET= argument '%s' is a procedure designator"_err_en_US,
- pointerSymbol->name(), targetName),
- *pointerSymbol);
- } else if (targetSymbol) {
- // object pointer and target
- SymbolVector symbols{GetSymbolVector(*targetExpr)};
- CHECK(!symbols.empty());
- if (!evaluate::GetLastTarget(symbols)) {
- parser::Message *msg{context.messages().Say(
- targetArg->sourceLocation(),
- "TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
- targetExpr->AsFortran())};
- for (SymbolRef ref : symbols) {
- msg = evaluate::AttachDeclaration(msg, *ref);
+ } else if (IsVariable(*targetExpr) || IsNullPointer(*targetExpr)) {
+ // Object pointer and target
+ if (ExtractDataRef(*targetExpr)) {
+ if (SymbolVector symbols{GetSymbolVector(*targetExpr)};
+ !evaluate::GetLastTarget(symbols)) {
+ parser::Message *msg{context.messages().Say(
+ targetArg->sourceLocation(),
+ "TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
+ targetExpr->AsFortran())};
+ for (SymbolRef ref : symbols) {
+ msg = evaluate::AttachDeclaration(msg, *ref);
+ }
+ } else if (HasVectorSubscript(*targetExpr) ||
+ ExtractCoarrayRef(*targetExpr)) {
+ context.messages().Say(targetArg->sourceLocation(),
+ "TARGET= argument '%s' may not have a vector subscript or coindexing"_err_en_US,
+ targetExpr->AsFortran());
}
- } else if (HasVectorSubscript(*targetExpr) ||
- ExtractCoarrayRef(*targetExpr)) {
- context.messages().Say(targetArg->sourceLocation(),
- "TARGET= argument '%s' may not have a vector subscript or coindexing"_err_en_US,
- targetExpr->AsFortran());
}
if (const auto pointerType{pointerArg->GetType()}) {
if (const auto targetType{targetArg->GetType()}) {
ok = pointerType->IsTkCompatibleWith(*targetType);
}
}
+ } else {
+ evaluate::AttachDeclaration(
+ context.messages().Say(
+ "POINTER= argument '%s' is an object pointer but the TARGET= argument '%s' is not a variable"_err_en_US,
+ pointerSymbol->name(), targetExpr->AsFortran()),
+ *pointerSymbol);
}
}
}
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 73a41088c7ccb1..f96d93b37bc903 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -95,6 +95,10 @@ subroutine test(assumedRank)
lvar = associated(realMatPtr, targetRealMat) ! ok
!ERROR: missing mandatory 'pointer=' argument
lVar = associated()
+ !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument '(targetintvar1)' is not a procedure or procedure pointer
+ lvar = associated(intprocPointer1, (targetIntVar1))
+ !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument '(targetintvar1)' is not a variable
+ lvar = associated(intPointerVar1, (targetIntVar1))
!ERROR: MOLD= argument to NULL() must be a pointer or allocatable
lVar = associated(null(intVar))
lVar = associated(null(intAllocVar)) !OK
@@ -164,7 +168,7 @@ subroutine test(assumedRank)
!WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
!ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument
lvar = associated(intProcPointer1, elementalProc)
- !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
+ !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is not a variable
lvar = associated (intPointerVar1, intFunc)
!ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
intPointerVar1 => intFunc
More information about the flang-commits
mailing list