Skip to content

Commit f82ee15

Browse files
klauslerklausler
authored
[flang] Don't check dummy vs. actual result rank for assumed-rank poi… (#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.
1 parent 8f3b0b4 commit f82ee15

6 files changed

Lines changed: 60 additions & 16 deletions

File tree

‎flang/lib/Semantics/check-call.cpp‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -329,10 +329,11 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
329329
typesCompatible = true;
330330
}
331331
}
332+
bool dummyIsAssumedRank{dummy.type.attrs().test(
333+
characteristics::TypeAndShape::Attr::AssumedRank)};
332334
if (typesCompatible) {
333335
if (isElemental) {
334-
} else if (dummy.type.attrs().test(
335-
characteristics::TypeAndShape::Attr::AssumedRank)) {
336+
} else if (dummyIsAssumedRank) {
336337
} else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
337338
} else if (dummyRank > 0 && !dummyIsAllocatableOrPointer &&
338339
!dummy.type.attrs().test(
@@ -462,8 +463,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
462463
: nullptr};
463464
int actualRank{actualType.Rank()};
464465
bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
465-
bool dummyIsAssumedRank{dummy.type.attrs().test(
466-
characteristics::TypeAndShape::Attr::AssumedRank)};
467466
if (dummy.type.attrs().test(
468467
characteristics::TypeAndShape::Attr::AssumedShape)) {
469468
// 15.5.2.4(16)
@@ -682,8 +681,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
682681
if (dummyIsPointer) {
683682
if (actualIsPointer || dummy.intent == common::Intent::In) {
684683
if (scope) {
685-
semantics::CheckPointerAssignment(
686-
context, messages.at(), dummyName, dummy, actual, *scope);
684+
semantics::CheckPointerAssignment(context, messages.at(), dummyName,
685+
dummy, actual, *scope,
686+
/*isAssumedRank=*/dummyIsAssumedRank);
687687
}
688688
} else if (!actualIsPointer) {
689689
messages.Say(

‎flang/lib/Semantics/check-declarations.cpp‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1067,7 +1067,8 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
10671067
SomeExpr lhs{evaluate::ProcedureDesignator{symbol}};
10681068
SomeExpr rhs{evaluate::ProcedureDesignator{**proc->init()}};
10691069
CheckPointerAssignment(context_, lhs, rhs,
1070-
GetProgramUnitOrBlockConstructContaining(symbol));
1070+
GetProgramUnitOrBlockConstructContaining(symbol),
1071+
/*isBoundsRemapping=*/false, /*isAssumedRank=*/false);
10711072
}
10721073
}
10731074
}

‎flang/lib/Semantics/data-to-inits.cpp‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -384,8 +384,9 @@ bool DataInitializationCompiler<DSV>::InitElement(
384384
return true;
385385
} else if (isProcPointer) {
386386
if (evaluate::IsProcedure(*expr)) {
387-
if (CheckPointerAssignment(
388-
exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
387+
if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr,
388+
DEREF(scope_),
389+
/*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) {
389390
if (lastSymbol->has<ProcEntityDetails>()) {
390391
GetImage().AddPointer(offsetSymbol.offset(), *expr);
391392
return true;

‎flang/lib/Semantics/pointer-assignment.cpp‎

Lines changed: 19 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ class PointerAssignmentChecker {
5656
PointerAssignmentChecker &set_isContiguous(bool);
5757
PointerAssignmentChecker &set_isVolatile(bool);
5858
PointerAssignmentChecker &set_isBoundsRemapping(bool);
59+
PointerAssignmentChecker &set_isAssumedRank(bool);
5960
PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
6061
bool CheckLeftHandSide(const SomeExpr &);
6162
bool Check(const SomeExpr &);
@@ -88,6 +89,7 @@ class PointerAssignmentChecker {
8889
bool isContiguous_{false};
8990
bool isVolatile_{false};
9091
bool isBoundsRemapping_{false};
92+
bool isAssumedRank_{false};
9193
const Symbol *pointerComponentLHS_{nullptr};
9294
};
9395

@@ -115,6 +117,12 @@ PointerAssignmentChecker &PointerAssignmentChecker::set_isBoundsRemapping(
115117
return *this;
116118
}
117119

120+
PointerAssignmentChecker &PointerAssignmentChecker::set_isAssumedRank(
121+
bool isAssumedRank) {
122+
isAssumedRank_ = isAssumedRank;
123+
return *this;
124+
}
125+
118126
PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
119127
const Symbol *symbol) {
120128
pointerComponentLHS_ = symbol;
@@ -263,7 +271,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
263271
CHECK(frTypeAndShape);
264272
if (!lhsType_->IsCompatibleWith(foldingContext_.messages(), *frTypeAndShape,
265273
"pointer", "function result",
266-
isBoundsRemapping_ /*omit shape check*/,
274+
/*omitShapeConformanceCheck=*/isBoundsRemapping_ || isAssumedRank_,
267275
evaluate::CheckConformanceFlags::BothDeferredShape)) {
268276
return false; // IsCompatibleWith() emitted message
269277
}
@@ -489,17 +497,20 @@ static bool CheckPointerBounds(
489497
bool CheckPointerAssignment(SemanticsContext &context,
490498
const evaluate::Assignment &assignment, const Scope &scope) {
491499
return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
492-
CheckPointerBounds(context.foldingContext(), assignment));
500+
CheckPointerBounds(context.foldingContext(), assignment),
501+
/*isAssumedRank=*/false);
493502
}
494503

495504
bool CheckPointerAssignment(SemanticsContext &context, const SomeExpr &lhs,
496-
const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping) {
505+
const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping,
506+
bool isAssumedRank) {
497507
const Symbol *pointer{GetLastSymbol(lhs)};
498508
if (!pointer) {
499509
return false; // error was reported
500510
}
501511
PointerAssignmentChecker checker{context, scope, *pointer};
502512
checker.set_isBoundsRemapping(isBoundsRemapping);
513+
checker.set_isAssumedRank(isAssumedRank);
503514
bool lhsOk{checker.CheckLeftHandSide(lhs)};
504515
bool rhsOk{checker.Check(rhs)};
505516
return lhsOk && rhsOk; // don't short-circuit
@@ -514,19 +525,22 @@ bool CheckStructConstructorPointerComponent(SemanticsContext &context,
514525

515526
bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
516527
const std::string &description, const DummyDataObject &lhs,
517-
const SomeExpr &rhs, const Scope &scope) {
528+
const SomeExpr &rhs, const Scope &scope, bool isAssumedRank) {
518529
return PointerAssignmentChecker{context, scope, source, description}
519530
.set_lhsType(common::Clone(lhs.type))
520531
.set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
521532
.set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
533+
.set_isAssumedRank(isAssumedRank)
522534
.Check(rhs);
523535
}
524536

525537
bool CheckInitialDataPointerTarget(SemanticsContext &context,
526538
const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
527539
return evaluate::IsInitialDataTarget(
528540
init, &context.foldingContext().messages()) &&
529-
CheckPointerAssignment(context, pointer, init, scope);
541+
CheckPointerAssignment(context, pointer, init, scope,
542+
/*isBoundsRemapping=*/false,
543+
/*isAssumedRank=*/false);
530544
}
531545

532546
} // namespace Fortran::semantics

‎flang/lib/Semantics/pointer-assignment.h‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,12 @@ class Symbol;
2626
bool CheckPointerAssignment(
2727
SemanticsContext &, const evaluate::Assignment &, const Scope &);
2828
bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
29-
const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
29+
const SomeExpr &rhs, const Scope &, bool isBoundsRemapping,
30+
bool isAssumedRank);
3031
bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
3132
const std::string &description,
3233
const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
33-
const Scope &);
34+
const Scope &, bool isAssumedRank);
3435

3536
bool CheckStructConstructorPointerComponent(
3637
SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);

‎flang/test/Semantics/call39.f90‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
2+
! Tests actual/dummy pointer argument shape mismatches
3+
module m
4+
contains
5+
subroutine s0(p)
6+
real, pointer, intent(in) :: p
7+
end
8+
subroutine s1(p)
9+
real, pointer, intent(in) :: p(:)
10+
end
11+
subroutine sa(p)
12+
real, pointer, intent(in) :: p(..)
13+
end
14+
subroutine test
15+
real, pointer :: a0, a1(:)
16+
call s0(null(a0)) ! ok
17+
!ERROR: Rank of dummy argument is 0, but actual argument has rank 1
18+
!ERROR: Rank of pointer is 0, but function result has rank 1
19+
call s0(null(a1))
20+
!ERROR: Rank of dummy argument is 1, but actual argument has rank 0
21+
!ERROR: Rank of pointer is 1, but function result has rank 0
22+
call s1(null(a0))
23+
call s1(null(a1)) ! ok
24+
call sa(null(a0)) ! ok
25+
call sa(null(a1)) ! ok
26+
end
27+
end

0 commit comments

Comments
 (0)