diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp index efe68be91b122..26d539ace479f 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 parser::Message *Say(parser::CharBlock at, A &&...args) { @@ -75,8 +74,11 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) { } } auto rhsLoc{std::get(stmt.t).source}; - CheckForPureContext(rhs, rhsLoc, false /*not a pointer assignment*/, - std::holds_alternative(assignment->u)); + if (std::holds_alternative(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(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 d398c5ec0d05a..3b0b2039cc7d5 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 14f2b0f0f7be9..215341e9c9a27 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()) { return std::nullopt; // error recovery } + const semantics::Scope &scope{context_.FindScope(typeName)}; + const semantics::Scope *pureContext{FindPureProcedureContaining(scope)}; const auto &typeDetails{typeSymbol.get()}; const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())}; @@ -1939,41 +1941,18 @@ MaybeExpr ExpressionAnalyzer::Analyze( } unavailable.insert(symbol->name()); if (value) { - if (symbol->has()) { - CHECK(IsPointer(*symbol)); - } else if (symbol->has()) { - // 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()) { + if (symbol->has()) { 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() || + symbol->has())) { + 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 86c6d9fa41e2e..d636cc0acca96 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 &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> 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 0000000000000..14a81567338c0 --- /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 ded84f62012fd..8916a3bab3228 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 2613a4de8d322..0c1e8544b02b1 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 8ce70ee11b2a9..002a81deffe09 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 673648979ab55..d1e86201c4d6a 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 7fad50cbbe7fa..92051afc216c1 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 64fc500b555a1..f2e659fb8974d 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 5a168fa72b689..728d2772039b7 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 0000000000000..af75b43658d32 --- /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 +