Skip to content

[flang] Catch C15104(4) violations when coindexing is present #130677

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 19, 2025
Merged

[flang] Catch C15104(4) violations when coindexing is present #130677

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 2 additions & 4 deletions flang/include/flang/Semantics/tools.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,10 +47,6 @@ const Scope *FindModuleFileContaining(const Scope &);
const Scope *FindPureProcedureContaining(const Scope &);
const Scope *FindOpenACCConstructContaining(const Scope *);

const Symbol *FindPointerComponent(const Scope &);
const Symbol *FindPointerComponent(const DerivedTypeSpec &);
const Symbol *FindPointerComponent(const DeclTypeSpec &);
const Symbol *FindPointerComponent(const Symbol &);
const Symbol *FindInterface(const Symbol &);
const Symbol *FindSubprogram(const Symbol &);
const Symbol *FindOverriddenBinding(
Expand Down Expand Up @@ -633,6 +629,8 @@ PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
const DerivedTypeSpec &, bool ignoreCoarrays = false);
PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent(
const DerivedTypeSpec &);
PotentialAndPointerComponentIterator::const_iterator
FindPointerPotentialComponent(const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
Expand Down
34 changes: 16 additions & 18 deletions flang/lib/Semantics/check-call.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -444,7 +444,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.type.type().AsFortran());
}

bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
auto actualCoarrayRef{ExtractCoarrayRef(actual)};
bool dummyIsAssumedSize{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedSize)};
bool dummyIsAsynchronous{
Expand All @@ -455,7 +455,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.attrs.test(characteristics::DummyDataObject::Attr::Value)};
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
if (actualIsPolymorphic && dummyIsPolymorphic &&
actualIsCoindexed) { // 15.5.2.4(2)
actualCoarrayRef) { // 15.5.2.4(2)
messages.Say(
"Coindexed polymorphic object may not be associated with a polymorphic %s"_err_en_US,
dummyName);
Expand Down Expand Up @@ -499,7 +499,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
}
if (actualIsCoindexed) {
if (actualCoarrayRef) {
if (dummy.intent != common::Intent::In && !dummyIsValue) {
if (auto bad{FindAllocatableUltimateComponent(
*actualDerived)}) { // 15.5.2.4(6)
Expand All @@ -508,15 +508,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
bad.BuildResultDesignatorName(), dummyName);
}
}
if (auto coarrayRef{evaluate::ExtractCoarrayRef(actual)}) { // C1537
const Symbol &coarray{coarrayRef->GetLastSymbol()};
if (const DeclTypeSpec * type{coarray.GetType()}) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
if (auto bad{semantics::FindPointerUltimateComponent(*derived)}) {
evaluate::SayWithDeclaration(messages, coarray,
"Coindexed object '%s' with POINTER ultimate component '%s' cannot be associated with %s"_err_en_US,
coarray.name(), bad.BuildResultDesignatorName(), dummyName);
}
const Symbol &coarray{actualCoarrayRef->GetLastSymbol()};
if (const DeclTypeSpec * type{coarray.GetType()}) { // C1537
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
if (auto bad{semantics::FindPointerUltimateComponent(*derived)}) {
evaluate::SayWithDeclaration(messages, coarray,
"Coindexed object '%s' with POINTER ultimate component '%s' cannot be associated with %s"_err_en_US,
coarray.name(), bad.BuildResultDesignatorName(), dummyName);
}
}
}
Expand Down Expand Up @@ -557,7 +555,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (actualRank == 0 && !actualIsAssumedRank &&
!dummyIsAllocatableOrPointer) {
// Actual is scalar, dummy is an array. F'2023 15.5.2.5p14
if (actualIsCoindexed) {
if (actualCoarrayRef) {
basicError = true;
messages.Say(
"Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
Expand Down Expand Up @@ -764,7 +762,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
if ((actualIsAsynchronous || actualIsVolatile) &&
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
if (actualIsCoindexed) { // C1538
if (actualCoarrayRef) { // C1538
messages.Say(
"Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US,
dummyName);
Expand All @@ -785,12 +783,12 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
if (dummyIsAllocatable) {
if (actualIsAllocatable) {
if (actualIsCoindexed && dummy.intent != common::Intent::In) {
if (actualCoarrayRef && dummy.intent != common::Intent::In) {
messages.Say(
"ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US,
dummyName);
}
if (!actualIsCoindexed && actualLastSymbol && dummy.type.corank() == 0 &&
if (!actualCoarrayRef && actualLastSymbol && dummy.type.corank() == 0 &&
actualLastSymbol->Corank() > 0) {
messages.Say(
"ALLOCATABLE %s is not a coarray but actual argument has corank %d"_err_en_US,
Expand Down Expand Up @@ -971,8 +969,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (dummy.attrs.test(characteristics::DummyDataObject::Attr::Target) &&
context.ShouldWarn(common::UsageWarning::NonTargetPassedToTarget)) {
bool actualIsVariable{evaluate::IsVariable(actual)};
bool actualIsTemp{!actualIsVariable || HasVectorSubscript(actual) ||
evaluate::ExtractCoarrayRef(actual)};
bool actualIsTemp{
!actualIsVariable || HasVectorSubscript(actual) || actualCoarrayRef};
if (actualIsTemp) {
messages.Say(common::UsageWarning::NonTargetPassedToTarget,
"Any pointer associated with TARGET %s during this call will not be associated with the value of '%s' afterwards"_warn_en_US,
Expand Down
24 changes: 16 additions & 8 deletions flang/lib/Semantics/expression.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2246,14 +2246,22 @@ MaybeExpr ExpressionAnalyzer::Analyze(
} else if (IsNullAllocatable(&*value) && IsAllocatable(*symbol)) {
result.Add(*symbol, Expr<SomeType>{NullPointer{}});
continue;
} else if (const Symbol * pointer{FindPointerComponent(*symbol)};
pointer && pureContext) { // C1594(4)
if (const Symbol *
visible{semantics::FindExternallyVisibleObject(
*value, *pureContext)}) {
Say(expr.source,
"The externally visible object '%s' may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
visible->name(), symbol->name(), pointer->name());
} else if (auto *derived{evaluate::GetDerivedTypeSpec(
evaluate::DynamicType::From(*symbol))}) {
if (auto iter{FindPointerPotentialComponent(*derived)};
iter && pureContext) { // F'2023 C15104(4)
if (const Symbol *
visible{semantics::FindExternallyVisibleObject(
*value, *pureContext)}) {
Say(expr.source,
"The externally visible object '%s' may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
visible->name(), symbol->name(),
iter.BuildResultDesignatorName());
} else if (ExtractCoarrayRef(*value)) {
Say(expr.source,
"A coindexed object may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
symbol->name(), iter.BuildResultDesignatorName());
}
}
}
// Make implicit conversion explicit to allow folding of the structure
Expand Down
2 changes: 1 addition & 1 deletion flang/lib/Semantics/pointer-assignment.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -194,7 +194,7 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
return true;
}
if (const auto *pureProc{FindPureProcedureContaining(scope_)}) {
if (pointerComponentLHS_) { // C1594(4) is a hard error
if (pointerComponentLHS_) { // F'2023 C15104(4) is a hard error
if (const Symbol * object{FindExternallyVisibleObject(rhs, *pureProc)}) {
if (auto *msg{Say(
"Externally visible object '%s' may not be associated with pointer component '%s' in a pure procedure"_err_en_US,
Expand Down
69 changes: 6 additions & 63 deletions flang/lib/Semantics/tools.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -311,69 +311,6 @@ bool IsBindCProcedure(const Scope &scope) {
}
}

static const Symbol *FindPointerComponent(
const Scope &scope, std::set<const Scope *> &visited) {
if (!scope.IsDerivedType()) {
return nullptr;
}
if (!visited.insert(&scope).second) {
return nullptr;
}
// If there's a top-level pointer component, return it for clearer error
// messaging.
for (const auto &pair : scope) {
const Symbol &symbol{*pair.second};
if (IsPointer(symbol)) {
return &symbol;
}
}
for (const auto &pair : scope) {
const Symbol &symbol{*pair.second};
if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
if (const DeclTypeSpec * type{details->type()}) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
if (const Scope * nested{derived->scope()}) {
if (const Symbol *
pointer{FindPointerComponent(*nested, visited)}) {
return pointer;
}
}
}
}
}
}
return nullptr;
}

const Symbol *FindPointerComponent(const Scope &scope) {
std::set<const Scope *> visited;
return FindPointerComponent(scope, visited);
}

const Symbol *FindPointerComponent(const DerivedTypeSpec &derived) {
if (const Scope * scope{derived.scope()}) {
return FindPointerComponent(*scope);
} else {
return nullptr;
}
}

const Symbol *FindPointerComponent(const DeclTypeSpec &type) {
if (const DerivedTypeSpec * derived{type.AsDerived()}) {
return FindPointerComponent(*derived);
} else {
return nullptr;
}
}

const Symbol *FindPointerComponent(const DeclTypeSpec *type) {
return type ? FindPointerComponent(*type) : nullptr;
}

const Symbol *FindPointerComponent(const Symbol &symbol) {
return IsPointer(symbol) ? &symbol : FindPointerComponent(symbol.GetType());
}

// C1594 specifies several ways by which an object might be globally visible.
const Symbol *FindExternallyVisibleObject(
const Symbol &object, const Scope &scope, bool isPointerDefinition) {
Expand Down Expand Up @@ -1393,6 +1330,12 @@ PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent(
[](const Symbol &symbol) { return evaluate::IsCoarray(symbol); });
}

PotentialAndPointerComponentIterator::const_iterator
FindPointerPotentialComponent(const DerivedTypeSpec &derived) {
PotentialAndPointerComponentIterator potentials{derived};
return std::find_if(potentials.begin(), potentials.end(), IsPointer);
}

UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &derived) {
UltimateComponentIterator ultimates{derived};
Expand Down
34 changes: 26 additions & 8 deletions flang/test/Semantics/structconst03.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ module module1

contains

pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
pure subroutine ps1(dummy1, dummy2, dummy3, dummy4, co2, co3, co4)
real, target :: local1
type(t1(0)) :: x1
type(t2(0)) :: x2
Expand All @@ -61,6 +61,9 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
real, intent(inout), target :: dummy4[*]
real, target :: commonvar1
common /cblock/ commonvar1
type(has_pointer1), intent(in out) :: co2[*]
type(has_pointer2), intent(in out) :: co3[*]
type(has_pointer3), intent(in out) :: co4[*]
x1 = t1(0)(local1)
!ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(0)(usedfrom1)
Expand All @@ -82,14 +85,20 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))
!ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))
!ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'
x2 = t2(0)(modulevar2)
!ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'
x3 = t3(0)(modulevar3)
!ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'
x4 = t4(0)(modulevar4)
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'
x2 = t2(0)(co2[1])
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'
x3 = t3(0)(co3[1])
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'
x4 = t4(0)(co4[1])
contains
pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a, co2a, co3a, co4a)
real, target :: local1a
type(t1(0)) :: x1a
type(t2(0)) :: x2a
Expand All @@ -99,6 +108,9 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
real, intent(inout), target :: dummy2a
real, pointer :: dummy3a
real, intent(inout), target :: dummy4a[*]
type(has_pointer1), intent(in out) :: co2a[*]
type(has_pointer2), intent(in out) :: co3a[*]
type(has_pointer3), intent(in out) :: co4a[*]
x1a = t1(0)(local1a)
!ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(0)(usedfrom1)
Expand All @@ -123,12 +135,18 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
x3a = t3(0)(has_pointer2(has_pointer1(modulevar1)))
!ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
x4a = t4(0)(has_pointer3(has_pointer1(modulevar1)))
!ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'
x2a = t2(0)(modulevar2)
!ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'
x3a = t3(0)(modulevar3)
!ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
!ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'
x4a = t4(0)(modulevar4)
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'
x2a = t2(0)(co2a[1])
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'
x3a = t3(0)(co3a[1])
!ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'
x4a = t4(0)(co4a[1])
end subroutine subr
end subroutine

Expand Down
Loading