Skip to content

Commit 1d8ecbe

Browse files
authored
[flang] Require contiguous actual pointer for contiguous dummy pointer (#139298)
When the actual argument associated with an explicitly CONTIGUOUS pointer dummy argument is itself a pointer, it must also be contiguous. (A non-pointer actual argument can associate with a CONTIGUOUS pointer dummy argument if it's INTENT(IN), and in that case it's still just a warning if we can't prove at compilation time that the actual is contiguous.) Fixes #138899.
1 parent 58535e8 commit 1d8ecbe

File tree

4 files changed

+23
-7
lines changed

4 files changed

+23
-7
lines changed

flang/lib/Semantics/check-call.cpp

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -772,12 +772,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
772772
}
773773
}
774774

775-
// Cases when temporaries might be needed but must not be permitted.
775+
bool dummyIsContiguous{
776+
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
776777
bool actualIsContiguous{IsSimplyContiguous(actual, foldingContext)};
778+
779+
// Cases when temporaries might be needed but must not be permitted.
777780
bool dummyIsAssumedShape{dummy.type.attrs().test(
778781
characteristics::TypeAndShape::Attr::AssumedShape)};
779-
bool dummyIsContiguous{
780-
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
781782
if ((actualIsAsynchronous || actualIsVolatile) &&
782783
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
783784
if (actualCoarrayRef) { // C1538
@@ -852,7 +853,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
852853
if (scope) {
853854
semantics::CheckPointerAssignment(context, messages.at(), dummyName,
854855
dummy, actual, *scope,
855-
/*isAssumedRank=*/dummyIsAssumedRank);
856+
/*isAssumedRank=*/dummyIsAssumedRank, actualIsPointer);
856857
}
857858
} else if (!actualIsPointer) {
858859
messages.Say(

flang/lib/Semantics/pointer-assignment.cpp

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ class PointerAssignmentChecker {
5959
PointerAssignmentChecker &set_isBoundsRemapping(bool);
6060
PointerAssignmentChecker &set_isAssumedRank(bool);
6161
PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
62+
PointerAssignmentChecker &set_isRHSPointerActualArgument(bool);
6263
bool CheckLeftHandSide(const SomeExpr &);
6364
bool Check(const SomeExpr &);
6465

@@ -94,6 +95,7 @@ class PointerAssignmentChecker {
9495
bool isVolatile_{false};
9596
bool isBoundsRemapping_{false};
9697
bool isAssumedRank_{false};
98+
bool isRHSPointerActualArgument_{false};
9799
const Symbol *pointerComponentLHS_{nullptr};
98100
};
99101

@@ -133,6 +135,12 @@ PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
133135
return *this;
134136
}
135137

138+
PointerAssignmentChecker &
139+
PointerAssignmentChecker::set_isRHSPointerActualArgument(bool isPointerActual) {
140+
isRHSPointerActualArgument_ = isPointerActual;
141+
return *this;
142+
}
143+
136144
bool PointerAssignmentChecker::CharacterizeProcedure() {
137145
if (!characterizedProcedure_) {
138146
characterizedProcedure_ = true;
@@ -221,6 +229,9 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
221229
Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
222230
return false;
223231
}
232+
} else if (isRHSPointerActualArgument_) {
233+
Say("CONTIGUOUS pointer dummy argument may not be associated with non-CONTIGUOUS pointer actual argument"_err_en_US);
234+
return false;
224235
} else {
225236
Warn(common::UsageWarning::PointerToPossibleNoncontiguous,
226237
"Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
@@ -590,12 +601,14 @@ bool CheckStructConstructorPointerComponent(SemanticsContext &context,
590601

591602
bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
592603
const std::string &description, const DummyDataObject &lhs,
593-
const SomeExpr &rhs, const Scope &scope, bool isAssumedRank) {
604+
const SomeExpr &rhs, const Scope &scope, bool isAssumedRank,
605+
bool isPointerActualArgument) {
594606
return PointerAssignmentChecker{context, scope, source, description}
595607
.set_lhsType(common::Clone(lhs.type))
596608
.set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
597609
.set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
598610
.set_isAssumedRank(isAssumedRank)
611+
.set_isRHSPointerActualArgument(isPointerActualArgument)
599612
.Check(rhs);
600613
}
601614

flang/lib/Semantics/pointer-assignment.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
3131
bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
3232
const std::string &description,
3333
const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
34-
const Scope &, bool isAssumedRank);
34+
const Scope &, bool isAssumedRank, bool IsPointerActualArgument);
3535

3636
bool CheckStructConstructorPointerComponent(
3737
SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);

flang/test/Semantics/call07.f90

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,10 @@ subroutine test
2727
!PORTABILITY: CONTIGUOUS entity 'scalar' should be an array pointer, assumed-shape, or assumed-rank
2828
real, contiguous :: scalar
2929
call s01(a03) ! ok
30-
!WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous
30+
!ERROR: CONTIGUOUS pointer dummy argument may not be associated with non-CONTIGUOUS pointer actual argument
3131
call s01(a02)
32+
!WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous
33+
call s01(a02(:))
3234
!ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target
3335
call s01(a03(::2))
3436
call s02(a02) ! ok

0 commit comments

Comments
 (0)