[flang] Don't check dummy vs. actual result rank for assumed-rank poi… #66237
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
…nters When associating a function result pointer as an actual argument with a dummy pointer that is assumed-rank, don't emit a bogus error. Pull request: llvm#66237
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics Changes…ntersWhen associating a function result pointer as an actual argument with a dummy pointer that is assumed-rank, don't emit a bogus error.Full diff: https://github.com/llvm/llvm-project/pull/66237.diff 6 Files Affected:
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c48c382218dc9bb..27abc9e2938af9f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -329,10 +329,11 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
typesCompatible = true;
}
}
+ bool dummyIsAssumedRank{dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank)};
if (typesCompatible) {
if (isElemental) {
- } else if (dummy.type.attrs().test(
- characteristics::TypeAndShape::Attr::AssumedRank)) {
+ } else if (dummyIsAssumedRank) {
} else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
} else if (dummyRank > 0 && !dummyIsAllocatableOrPointer &&
!dummy.type.attrs().test(
@@ -462,8 +463,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
: nullptr};
int actualRank{actualType.Rank()};
bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
- bool dummyIsAssumedRank{dummy.type.attrs().test(
- characteristics::TypeAndShape::Attr::AssumedRank)};
if (dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)) {
// 15.5.2.4(16)
@@ -682,8 +681,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (dummyIsPointer) {
if (actualIsPointer || dummy.intent == common::Intent::In) {
if (scope) {
- semantics::CheckPointerAssignment(
- context, messages.at(), dummyName, dummy, actual, *scope);
+ semantics::CheckPointerAssignment(context, messages.at(), dummyName,
+ dummy, actual, *scope,
+ /*isAssumedRank=*/dummyIsAssumedRank);
}
} else if (!actualIsPointer) {
messages.Say(
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index e7e091ed024c48d..b22f396643c9b21 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1062,7 +1062,8 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
SomeExpr lhs{evaluate::ProcedureDesignator{symbol}};
SomeExpr rhs{evaluate::ProcedureDesignator{**proc->init()}};
CheckPointerAssignment(context_, lhs, rhs,
- GetProgramUnitOrBlockConstructContaining(symbol));
+ GetProgramUnitOrBlockConstructContaining(symbol),
+ /*isBoundsRemapping=*/false, /*isAssumedRank=*/false);
}
}
}
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 6fbe044aa4618d4..bc0355a2c597a6f 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -384,8 +384,9 @@ bool DataInitializationCompiler<DSV>::InitElement(
return true;
} else if (isProcPointer) {
if (evaluate::IsProcedure(*expr)) {
- if (CheckPointerAssignment(
- exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
+ if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr,
+ DEREF(scope_),
+ /*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) {
if (lastSymbol->has<ProcEntityDetails>()) {
GetImage().AddPointer(offsetSymbol.offset(), *expr);
return true;
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index e75e9366942115d..8f01a3d7057e196 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -56,6 +56,7 @@ class PointerAssignmentChecker {
PointerAssignmentChecker &set_isContiguous(bool);
PointerAssignmentChecker &set_isVolatile(bool);
PointerAssignmentChecker &set_isBoundsRemapping(bool);
+ PointerAssignmentChecker &set_isAssumedRank(bool);
PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
bool CheckLeftHandSide(const SomeExpr &);
bool Check(const SomeExpr &);
@@ -88,6 +89,7 @@ class PointerAssignmentChecker {
bool isContiguous_{false};
bool isVolatile_{false};
bool isBoundsRemapping_{false};
+ bool isAssumedRank_{false};
const Symbol *pointerComponentLHS_{nullptr};
};
@@ -115,6 +117,12 @@ PointerAssignmentChecker &PointerAssignmentChecker::set_isBoundsRemapping(
return *this;
}
+PointerAssignmentChecker &PointerAssignmentChecker::set_isAssumedRank(
+ bool isAssumedRank) {
+ isAssumedRank_ = isAssumedRank;
+ return *this;
+}
+
PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
const Symbol *symbol) {
pointerComponentLHS_ = symbol;
@@ -263,7 +271,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
CHECK(frTypeAndShape);
if (!lhsType_->IsCompatibleWith(foldingContext_.messages(), *frTypeAndShape,
"pointer", "function result",
- isBoundsRemapping_ /*omit shape check*/,
+ /*omitShapeConformanceCheck=*/isBoundsRemapping_ || isAssumedRank_,
evaluate::CheckConformanceFlags::BothDeferredShape)) {
return false; // IsCompatibleWith() emitted message
}
@@ -489,17 +497,20 @@ static bool CheckPointerBounds(
bool CheckPointerAssignment(SemanticsContext &context,
const evaluate::Assignment &assignment, const Scope &scope) {
return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
- CheckPointerBounds(context.foldingContext(), assignment));
+ CheckPointerBounds(context.foldingContext(), assignment),
+ /*isAssumedRank=*/false);
}
bool CheckPointerAssignment(SemanticsContext &context, const SomeExpr &lhs,
- const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping) {
+ const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping,
+ bool isAssumedRank) {
const Symbol *pointer{GetLastSymbol(lhs)};
if (!pointer) {
return false; // error was reported
}
PointerAssignmentChecker checker{context, scope, *pointer};
checker.set_isBoundsRemapping(isBoundsRemapping);
+ checker.set_isAssumedRank(isAssumedRank);
bool lhsOk{checker.CheckLeftHandSide(lhs)};
bool rhsOk{checker.Check(rhs)};
return lhsOk && rhsOk; // don't short-circuit
@@ -514,11 +525,12 @@ bool CheckStructConstructorPointerComponent(SemanticsContext &context,
bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
const std::string &description, const DummyDataObject &lhs,
- const SomeExpr &rhs, const Scope &scope) {
+ const SomeExpr &rhs, const Scope &scope, bool isAssumedRank) {
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))
+ .set_isAssumedRank(isAssumedRank)
.Check(rhs);
}
@@ -526,7 +538,9 @@ bool CheckInitialDataPointerTarget(SemanticsContext &context,
const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
return evaluate::IsInitialDataTarget(
init, &context.foldingContext().messages()) &&
- CheckPointerAssignment(context, pointer, init, scope);
+ CheckPointerAssignment(context, pointer, init, scope,
+ /*isBoundsRemapping=*/false,
+ /*isAssumedRank=*/false);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/pointer-assignment.h b/flang/lib/Semantics/pointer-assignment.h
index 5ac258d03a0a264..269d64112fd29b6 100644
--- a/flang/lib/Semantics/pointer-assignment.h
+++ b/flang/lib/Semantics/pointer-assignment.h
@@ -26,11 +26,12 @@ class Symbol;
bool CheckPointerAssignment(
SemanticsContext &, const evaluate::Assignment &, const Scope &);
bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
- const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
+ const SomeExpr &rhs, const Scope &, bool isBoundsRemapping,
+ bool isAssumedRank);
bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
const std::string &description,
const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
- const Scope &);
+ const Scope &, bool isAssumedRank);
bool CheckStructConstructorPointerComponent(
SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);
diff --git a/flang/test/Semantics/call39.f90 b/flang/test/Semantics/call39.f90
new file mode 100644
index 000000000000000..860ab0096401403
--- /dev/null
+++ b/flang/test/Semantics/call39.f90
@@ -0,0 +1,27 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+! Tests actual/dummy pointer argument shape mismatches
+module m
+ contains
+ subroutine s0(p)
+ real, pointer, intent(in) :: p
+ end
+ subroutine s1(p)
+ real, pointer, intent(in) :: p(:)
+ end
+ subroutine sa(p)
+ real, pointer, intent(in) :: p(..)
+ end
+ subroutine test
+ real, pointer :: a0, a1(:)
+ call s0(null(a0)) ! ok
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ !ERROR: Rank of pointer is 0, but function result has rank 1
+ call s0(null(a1))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Rank of pointer is 1, but function result has rank 0
+ call s1(null(a0))
+ call s1(null(a1)) ! ok
+ call sa(null(a0)) ! ok
+ call sa(null(a1)) ! ok
+ end
+end
|
ZijunZhaoCCK
pushed a commit
to ZijunZhaoCCK/llvm-project
that referenced
this pull request
Sep 19, 2023
llvm#66237) …nters When associating a function result pointer as an actual argument with a dummy pointer that is assumed-rank, don't emit a bogus error.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
…nters
When associating a function result pointer as an actual argument with a dummy pointer that is assumed-rank, don't emit a bogus error.