! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic ! Error tests for structure constructors: C1594 violations ! from assigning globally-visible data to POINTER components. ! This test is structconst03.f90 with the type parameters removed. module usefrom real, target :: usedfrom1 end module usefrom module module1 use usefrom implicit none type :: has_pointer1 real, pointer :: ptop type(has_pointer1), allocatable :: link1 ! don't loop during analysis end type has_pointer1 type :: has_pointer2 type(has_pointer1) :: pnested type(has_pointer2), allocatable :: link2 end type has_pointer2 type, extends(has_pointer2) :: has_pointer3 type(has_pointer3), allocatable :: link3 end type has_pointer3 type :: t1 real, pointer :: pt1 type(t1), allocatable :: link end type t1 type :: t2 type(has_pointer1) :: hp1 type(t2), allocatable :: link end type t2 type :: t3 type(has_pointer2) :: hp2 type(t3), allocatable :: link end type t3 type :: t4 type(has_pointer3) :: hp3 type(t4), allocatable :: link end type t4 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 pure subroutine ps1(dummy1, dummy2, dummy3, dummy4) real, target :: local1 type(t1) :: x1 type(t2) :: x2 type(t3) :: x3 type(t4) :: x4 real, intent(in), target :: dummy1 real, intent(inout), target :: dummy2 real, pointer :: dummy3 real, intent(inout), target :: dummy4[*] real, target :: commonvar1 common /cblock/ commonvar1 x1 = t1(local1) !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure x1 = t1(usedfrom1) !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure x1 = t1(modulevar1) !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure x1 = t1(commonvar1) !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure x1 = t1(dummy1) x1 = t1(dummy2) x1 = t1(dummy3) ! TODO when semantics handles coindexing: ! 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 '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: 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: 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) real, target :: local1a type(t1) :: x1a type(t2) :: x2a type(t3) :: x3a type(t4) :: x4a real, intent(in), target :: dummy1a real, intent(inout), target :: dummy2a real, pointer :: dummy3a real, intent(inout), target :: dummy4a[*] x1a = t1(local1a) !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(usedfrom1) !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(modulevar1) !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(commonvar1) !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(dummy1) !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(dummy1a) x1a = t1(dummy2a) x1a = t1(dummy3) x1a = t1(dummy3a) ! TODO when semantics handles coindexing: ! 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 '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: 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: 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 pure integer function pf1(dummy3) real, pointer :: dummy3 type(t1) :: x1 !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure x1 = t1(dummy3) contains pure subroutine subr(dummy3a) real, pointer :: dummy3a type(t1) :: x1a !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure x1a = t1(dummy3) x1a = t1(dummy3a) end subroutine end function impure real function ipf1(dummy1, dummy2, dummy3, dummy4) real, target :: local1 type(t1) :: x1 type(t2) :: x2 type(t3) :: x3 type(t4) :: x4 real, intent(in), target :: dummy1 real, intent(inout), target :: dummy2 real, pointer :: dummy3 real, intent(inout), target :: dummy4[*] real, target :: commonvar1 common /cblock/ commonvar1 ipf1 = 0. x1 = t1(local1) 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) end function ipf1 end module module1