[flang-commits] [flang] 1fa9ef6 - [flang] Consolidate and enhance pointer assignment checks
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Mar 27 16:20:00 PDT 2023
Author: Peter Klausler
Date: 2023-03-27T16:19:54-07:00
New Revision: 1fa9ef620ba61c800040091b97acc26cbaa6d2f4
URL: https://github.com/llvm/llvm-project/commit/1fa9ef620ba61c800040091b97acc26cbaa6d2f4
DIFF: https://github.com/llvm/llvm-project/commit/1fa9ef620ba61c800040091b97acc26cbaa6d2f4.diff
LOG: [flang] Consolidate and enhance pointer assignment checks
Consolidate aspects of pointer assignment & structure constructor pointer component
checking from Semantics/assignment.cpp and /expression.cpp into /pointer-assignment.cpp,
and add a warning about data targets that are not definable objects
but not hard errors. Specifically, a structure component pointer component data
target is not allowed to be a USE-associated object in a pure context by a numbered
constraint, but the right-hand side data target of a pointer assignment statement
has no such constraint, and that's the new warning.
Differential Revision: https://reviews.llvm.org/D146581
Added:
flang/test/Semantics/assign14.f90
flang/test/Semantics/structconst07.f90#
Modified:
flang/lib/Semantics/assignment.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/test/Semantics/associate01.f90
flang/test/Semantics/c_f_pointer.f90
flang/test/Semantics/call05.f90
flang/test/Semantics/call07.f90
flang/test/Semantics/call33.f90
flang/test/Semantics/structconst03.f90
flang/test/Semantics/structconst04.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index efe68be91b12..26d539ace479 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -44,8 +44,7 @@ class AssignmentContext {
void Analyze(const parser::ConcurrentControl &);
private:
- bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource,
- bool isPointerAssignment, bool isDefinedAssignment);
+ bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource);
void CheckShape(parser::CharBlock, const SomeExpr *);
template <typename... A>
parser::Message *Say(parser::CharBlock at, A &&...args) {
@@ -75,8 +74,11 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
}
}
auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
- CheckForPureContext(rhs, rhsLoc, false /*not a pointer assignment*/,
- std::holds_alternative<evaluate::ProcedureRef>(assignment->u));
+ if (std::holds_alternative<evaluate::ProcedureRef>(assignment->u)) {
+ // it's a defined ASSIGNMENT(=)
+ } else {
+ CheckForPureContext(rhs, rhsLoc);
+ }
if (whereDepth_ > 0) {
CheckShape(lhsLoc, &lhs);
}
@@ -86,14 +88,10 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
CHECK(whereDepth_ == 0);
if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
- const SomeExpr &rhs{assignment->rhs};
- CheckForPureContext(rhs, std::get<parser::Expr>(stmt.t).source,
- true /*this is a pointer assignment*/,
- false /*not a defined assignment*/);
parser::CharBlock at{context_.location().value()};
auto restorer{foldingContext().messages().SetLocation(at)};
- const Scope &scope{context_.FindScope(at)};
- CheckPointerAssignment(foldingContext(), *assignment, scope);
+ CheckPointerAssignment(
+ foldingContext(), *assignment, context_.FindScope(at));
}
}
@@ -128,29 +126,16 @@ bool CheckCopyabilityInPureScope(parser::ContextualMessages &messages,
return true;
}
-bool AssignmentContext::CheckForPureContext(const SomeExpr &rhs,
- parser::CharBlock rhsSource, bool isPointerAssignment,
- bool isDefinedAssignment) {
+bool AssignmentContext::CheckForPureContext(
+ const SomeExpr &rhs, parser::CharBlock rhsSource) {
const Scope &scope{context_.FindScope(rhsSource)};
- if (!FindPureProcedureContaining(scope)) {
- return true;
- }
- parser::ContextualMessages messages{
- context_.location().value(), &context_.messages()};
- if (isPointerAssignment) {
- if (const Symbol * base{GetFirstSymbol(rhs)}) {
- if (const char *why{WhyBaseObjectIsSuspicious(
- base->GetUltimate(), scope)}) { // C1594(3)
- evaluate::SayWithDeclaration(messages, *base,
- "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
- base->name(), why);
- return false;
- }
- }
- } else if (!isDefinedAssignment) {
+ if (FindPureProcedureContaining(scope)) {
+ parser::ContextualMessages messages{
+ context_.location().value(), &context_.messages()};
return CheckCopyabilityInPureScope(messages, rhs, scope);
+ } else {
+ return true;
}
- return true;
}
// 10.2.3.1(2) The masks and LHS of assignments must be arrays of the same shape
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index d398c5ec0d05..3b0b2039cc7d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -494,23 +494,16 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// 15.5.2.7 -- dummy is POINTER
if (dummyIsPointer) {
- if (dummyIsContiguous && !actualIsContiguous) {
+ if (actualIsPointer || dummy.intent == common::Intent::In) {
+ if (scope) {
+ semantics::CheckPointerAssignment(
+ context, messages.at(), dummyName, dummy, actual, *scope);
+ }
+ } else if (!actualIsPointer) {
messages.Say(
- "Actual argument associated with CONTIGUOUS POINTER %s must be simply contiguous"_err_en_US,
+ "Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
dummyName);
}
- if (!actualIsPointer) {
- if (dummy.intent == common::Intent::In) {
- if (scope) {
- semantics::CheckPointerAssignment(
- context, messages.at(), dummyName, dummy, actual, *scope);
- }
- } else {
- messages.Say(
- "Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
- dummyName);
- }
- }
}
// 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 14f2b0f0f7be..215341e9c9a2 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1814,6 +1814,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(
if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
return std::nullopt; // error recovery
}
+ const semantics::Scope &scope{context_.FindScope(typeName)};
+ const semantics::Scope *pureContext{FindPureProcedureContaining(scope)};
const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
@@ -1939,41 +1941,18 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
unavailable.insert(symbol->name());
if (value) {
- if (symbol->has<semantics::ProcEntityDetails>()) {
- CHECK(IsPointer(*symbol));
- } else if (symbol->has<semantics::ObjectEntityDetails>()) {
- // C1594(4)
- if (const auto *pureProc{FindPureProcedureContaining(innermost)}) {
- if (const Symbol *pointer{FindPointerComponent(*symbol)}) {
- if (const Symbol *object{
- FindExternallyVisibleObject(*value, *pureProc)}) {
- if (auto *msg{Say(expr.source,
- "Externally visible object '%s' may not be "
- "associated with pointer component '%s' in a "
- "pure procedure"_err_en_US,
- object->name(), pointer->name())}) {
- msg->Attach(object->name(), "Object declaration"_en_US)
- .Attach(pointer->name(), "Pointer declaration"_en_US);
- }
- }
- }
- }
- } else if (symbol->has<semantics::TypeParamDetails>()) {
+ if (symbol->has<semantics::TypeParamDetails>()) {
Say(expr.source,
- "Type parameter '%s' may not appear as a component "
- "of a structure constructor"_err_en_US,
+ "Type parameter '%s' may not appear as a component of a structure constructor"_err_en_US,
symbol->name());
- continue;
- } else {
- Say(expr.source,
- "Component '%s' is neither a procedure pointer "
- "nor a data object"_err_en_US,
- symbol->name());
- continue;
}
- if (IsPointer(*symbol)) {
+ if (!(symbol->has<semantics::ProcEntityDetails>() ||
+ symbol->has<semantics::ObjectEntityDetails>())) {
+ continue; // recovery
+ }
+ if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
semantics::CheckStructConstructorPointerComponent(
- GetFoldingContext(), *symbol, *value, innermost); // C7104, C7105
+ GetFoldingContext(), *symbol, *value, innermost);
result.Add(*symbol, Fold(std::move(*value)));
continue;
}
@@ -2008,6 +1987,15 @@ MaybeExpr ExpressionAnalyzer::Analyze(
*symbol);
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());
+ }
}
if (MaybeExpr converted{ConvertToType(*symbol, std::move(*value))}) {
if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 86c6d9fa41e2..d636cc0acca9 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -57,6 +57,7 @@ class PointerAssignmentChecker {
PointerAssignmentChecker &set_isContiguous(bool);
PointerAssignmentChecker &set_isVolatile(bool);
PointerAssignmentChecker &set_isBoundsRemapping(bool);
+ PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
bool CheckLeftHandSide(const SomeExpr &);
bool Check(const SomeExpr &);
@@ -87,6 +88,7 @@ class PointerAssignmentChecker {
bool isContiguous_{false};
bool isVolatile_{false};
bool isBoundsRemapping_{false};
+ const Symbol *pointerComponentLHS_{nullptr};
};
PointerAssignmentChecker &PointerAssignmentChecker::set_lhsType(
@@ -113,6 +115,12 @@ PointerAssignmentChecker &PointerAssignmentChecker::set_isBoundsRemapping(
return *this;
}
+PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
+ const Symbol *symbol) {
+ pointerComponentLHS_ = symbol;
+ return *this;
+}
+
bool PointerAssignmentChecker::CharacterizeProcedure() {
if (!characterizedProcedure_) {
characterizedProcedure_ = true;
@@ -126,7 +134,7 @@ bool PointerAssignmentChecker::CharacterizeProcedure() {
bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
if (auto whyNot{WhyNotDefinable(context_.messages().at(), scope_,
DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
- if (auto *msg{context_.messages().Say(
+ if (auto *msg{Say(
"The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
msg->Attach(std::move(*whyNot));
}
@@ -153,12 +161,62 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
if (HasVectorSubscript(rhs)) { // C1025
Say("An array section with a vector subscript may not be a pointer target"_err_en_US);
return false;
- } else if (ExtractCoarrayRef(rhs)) { // C1026
+ }
+ if (ExtractCoarrayRef(rhs)) { // C1026
Say("A coindexed object may not be a pointer target"_err_en_US);
return false;
- } else {
- return common::visit([&](const auto &x) { return Check(x); }, rhs.u);
}
+ if (!common::visit([&](const auto &x) { return Check(x); }, rhs.u)) {
+ return false;
+ }
+ if (IsNullPointer(rhs)) {
+ return true;
+ }
+ if (lhs_ && IsProcedure(*lhs_)) {
+ return true;
+ }
+ if (const auto *pureProc{FindPureProcedureContaining(scope_)}) {
+ if (pointerComponentLHS_) { // C1594(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,
+ object->name(), pointerComponentLHS_->name())}) {
+ msg->Attach(object->name(), "Object declaration"_en_US)
+ .Attach(
+ pointerComponentLHS_->name(), "Pointer declaration"_en_US);
+ }
+ return false;
+ }
+ } else if (const Symbol * base{GetFirstSymbol(rhs)}) {
+ if (const char *why{WhyBaseObjectIsSuspicious(
+ base->GetUltimate(), scope_)}) { // C1594(3)
+ evaluate::SayWithDeclaration(context_.messages(), *base,
+ "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
+ base->name(), why);
+ return false;
+ }
+ }
+ }
+ if (isContiguous_) {
+ if (auto contiguous{evaluate::IsContiguous(rhs, context_)}) {
+ if (!*contiguous) {
+ Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
+ return false;
+ }
+ } else {
+ Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
+ }
+ }
+ // Warn about undefinable data targets
+ if (auto because{
+ WhyNotDefinable(context_.messages().at(), scope_, {}, rhs)}) {
+ if (auto *msg{
+ Say("Pointer target is not a definable variable"_warn_en_US)}) {
+ msg->Attach(std::move(*because));
+ }
+ return false;
+ }
+ return true;
}
bool PointerAssignmentChecker::Check(const evaluate::NullPointer &) {
@@ -221,7 +279,7 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
const Symbol *base{d.GetBaseObject().symbol()};
if (!last || !base) {
// P => "character literal"(1:3)
- context_.messages().Say("Pointer target is not a named entity"_err_en_US);
+ Say("Pointer target is not a named entity"_err_en_US);
return false;
}
std::optional<std::variant<MessageFixedText, MessageFormattedText>> msg;
@@ -440,8 +498,9 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &context,
const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
- CHECK(IsPointer(lhs));
- return PointerAssignmentChecker{context, scope, lhs}.Check(rhs);
+ return PointerAssignmentChecker{context, scope, lhs}
+ .set_pointerComponentLHS(&lhs)
+ .Check(rhs);
}
bool CheckPointerAssignment(evaluate::FoldingContext &context,
diff --git a/flang/test/Semantics/assign14.f90 b/flang/test/Semantics/assign14.f90
new file mode 100644
index 000000000000..14a81567338c
--- /dev/null
+++ b/flang/test/Semantics/assign14.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Can't associate a pointer with a substring of a character literal
+program main
+ character(:), pointer :: cp
+ !ERROR: Target associated with pointer 'cp' must be a designator or a call to a pointer-valued function
+ cp => "abcd"(1:4)
+end
diff --git a/flang/test/Semantics/associate01.f90 b/flang/test/Semantics/associate01.f90
index ded84f62012f..8916a3bab322 100644
--- a/flang/test/Semantics/associate01.f90
+++ b/flang/test/Semantics/associate01.f90
@@ -13,6 +13,8 @@ module m1
function iptr(n)
integer, intent(in), target :: n
integer, pointer :: iptr
+ !WARNING: Pointer target is not a definable variable
+ !BECAUSE: 'n' is an INTENT(IN) dummy argument
iptr => n
end function
subroutine test
diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index 2613a4de8d32..0c1e8544b02b 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -30,6 +30,7 @@ program test
!ERROR: FPTR= argument to C_F_POINTER() may not have a deferred type parameter
call c_f_pointer(scalarC, charDeferredF)
!ERROR: FPTR= argument to C_F_POINTER() may not be a coindexed object
+ !ERROR: A coindexed object may not be a pointer target
call c_f_pointer(scalarC, coindexed[0]%p)
!ERROR: FPTR= argument to C_F_POINTER() must have a type
call c_f_pointer(scalarC, null())
diff --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index 8ce70ee11b2a..002a81deffe0 100644
--- a/flang/test/Semantics/call05.f90
+++ b/flang/test/Semantics/call05.f90
@@ -86,6 +86,7 @@ subroutine test
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
call sua(pa)
!ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
+ !ERROR: Pointer type must be unlimited polymorphic or non-extensible derived type when target is unlimited polymorphic
call spp(up)
!ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
call spa(ua)
@@ -94,6 +95,7 @@ subroutine test
!ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
call spa(pa2)
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ !ERROR: Pointer has rank 1 but target has rank 2
call smp(mpmat)
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
call sma(mamat)
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index 673648979ab5..d1e86201c4d6 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -25,9 +25,9 @@ subroutine test
real, target :: a03(10)
real :: a04(10) ! not TARGET
call s01(a03) ! ok
- !ERROR: Actual argument associated with CONTIGUOUS POINTER dummy argument 'p=' must be simply contiguous
+ !WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous
call s01(a02)
- !ERROR: Actual argument associated with CONTIGUOUS POINTER dummy argument 'p=' must be simply contiguous
+ !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target
call s01(a03(::2))
call s02(a02) ! ok
call s03(a03) ! ok
diff --git a/flang/test/Semantics/call33.f90 b/flang/test/Semantics/call33.f90
index 7fad50cbbe7f..92051afc216c 100644
--- a/flang/test/Semantics/call33.f90
+++ b/flang/test/Semantics/call33.f90
@@ -40,6 +40,7 @@ program test
!ERROR: Actual argument variable length '2' does not match the expected length '3'
call s5(shortalloc)
!ERROR: Actual argument variable length '2' does not match the expected length '3'
+ !ERROR: Target type CHARACTER(KIND=1,LEN=2_8) is not compatible with pointer type CHARACTER(KIND=1,LEN=3_8)
call s6(shortptr)
call s1(long) ! ok
call s2(longarr) ! ok
@@ -50,5 +51,6 @@ program test
!ERROR: Actual argument variable length '4' does not match the expected length '3'
call s5(longalloc)
!ERROR: Actual argument variable length '4' does not match the expected length '3'
+ !ERROR: Target type CHARACTER(KIND=1,LEN=4_8) is not compatible with pointer type CHARACTER(KIND=1,LEN=3_8)
call s6(longptr)
end
diff --git a/flang/test/Semantics/structconst03.f90 b/flang/test/Semantics/structconst03.f90
index 64fc500b555a..f2e659fb8974 100644
--- a/flang/test/Semantics/structconst03.f90
+++ b/flang/test/Semantics/structconst03.f90
@@ -42,10 +42,10 @@ module module1
type(has_pointer3) :: hp3
type(t4(k)), allocatable :: link
end type t4
- real, target :: modulevar1
- type(has_pointer1) :: modulevar2
- type(has_pointer2) :: modulevar3
- type(has_pointer3) :: modulevar4
+ real, target :: modulevar1 = 0.
+ type(has_pointer1) :: modulevar2 = has_pointer1(modulevar1)
+ type(has_pointer2) :: modulevar3 = has_pointer2(has_pointer1(modulevar1))
+ type(has_pointer3) :: modulevar4 = has_pointer3(has_pointer1(modulevar1))
contains
@@ -76,11 +76,17 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1 = t1(0)(dummy4[0])
x1 = t1(0)(dummy4)
- !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x2 = t2(0)(has_pointer1(modulevar1))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ 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'
x2 = t2(0)(modulevar2)
- !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x3 = t3(0)(modulevar3)
- !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x4 = t4(0)(modulevar4)
contains
pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
@@ -111,11 +117,17 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1a = t1(0)(dummy4a[0])
x1a = t1(0)(dummy4a)
- !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x2a = t2(0)(has_pointer1(modulevar1))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ 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'
x2a = t2(0)(modulevar2)
- !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x3a = t3(0)(modulevar3)
- !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x4a = t4(0)(modulevar4)
end subroutine subr
end subroutine
@@ -153,12 +165,17 @@ impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
x1 = t1(0)(usedfrom1)
x1 = t1(0)(modulevar1)
x1 = t1(0)(commonvar1)
+ !WARNING: Pointer target is not a definable variable
+ !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument
x1 = t1(0)(dummy1)
x1 = t1(0)(dummy2)
x1 = t1(0)(dummy3)
! TODO when semantics handles coindexing:
! TODO x1 = t1(0)(dummy4[0])
x1 = t1(0)(dummy4)
+ x2 = t2(0)(has_pointer1(modulevar1))
+ x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))
+ x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))
x2 = t2(0)(modulevar2)
x3 = t3(0)(modulevar3)
x4 = t4(0)(modulevar4)
diff --git a/flang/test/Semantics/structconst04.f90 b/flang/test/Semantics/structconst04.f90
index 5a168fa72b68..728d2772039b 100644
--- a/flang/test/Semantics/structconst04.f90
+++ b/flang/test/Semantics/structconst04.f90
@@ -37,10 +37,10 @@ module module1
type(has_pointer3) :: hp3
type(t4), allocatable :: link
end type t4
- real, target :: modulevar1
- type(has_pointer1) :: modulevar2
- type(has_pointer2) :: modulevar3
- type(has_pointer3) :: modulevar4
+ real, target :: modulevar1 = 0.
+ type(has_pointer1) :: modulevar2 = has_pointer1(modulevar1)
+ type(has_pointer2) :: modulevar3 = has_pointer2(has_pointer1(modulevar1))
+ type(has_pointer3) :: modulevar4 = has_pointer3(has_pointer1(modulevar1))
contains
@@ -71,11 +71,17 @@ pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1 = t1(dummy4[0])
x1 = t1(dummy4)
- !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x2 = t2(has_pointer1(modulevar1))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x3 = t3(has_pointer2(has_pointer1(modulevar1)))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x4 = t4(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'
x2 = t2(modulevar2)
- !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x3 = t3(modulevar3)
- !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x4 = t4(modulevar4)
contains
pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
@@ -106,11 +112,17 @@ pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1a = t1(dummy4a[0])
x1a = t1(dummy4a)
- !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x2a = t2(has_pointer1(modulevar1))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x3a = t3(has_pointer2(has_pointer1(modulevar1)))
+ !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
+ x4a = t4(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'
x2a = t2(modulevar2)
- !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x3a = t3(modulevar3)
- !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
+ !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'
x4a = t4(modulevar4)
end subroutine subr
end subroutine
@@ -147,12 +159,17 @@ impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
x1 = t1(usedfrom1)
x1 = t1(modulevar1)
x1 = t1(commonvar1)
+ !WARNING: Pointer target is not a definable variable
+ !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument
x1 = t1(dummy1)
x1 = t1(dummy2)
x1 = t1(dummy3)
! TODO when semantics handles coindexing:
! TODO x1 = t1(dummy4[0])
x1 = t1(dummy4)
+ x2 = t2(has_pointer1(modulevar1))
+ x3 = t3(has_pointer2(has_pointer1(modulevar1)))
+ x4 = t4(has_pointer3(has_pointer1(modulevar1)))
x2 = t2(modulevar2)
x3 = t3(modulevar3)
x4 = t4(modulevar4)
diff --git a/flang/test/Semantics/structconst07.f90# b/flang/test/Semantics/structconst07.f90#
new file mode 100644
index 000000000000..af75b43658d3
--- /dev/null
+++ b/flang/test/Semantics/structconst07.f90#
@@ -0,0 +1,5 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! C1594(4)
+module m
+ type t1
+
More information about the flang-commits
mailing list