flang/test/Semantics/structconst08.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 !
   3 ! Error tests for structure constructors of derived types with allocatable components
   4
   5 module m
   6   type parent1
   7     integer, allocatable :: pa
   8   end type parent1
   9   type parent2
  10     real, allocatable :: pa(:)
  11   end type parent2
  12   type child
  13     integer :: i
  14     type(parent2) :: ca
  15   end type
  16
  17 contains
  18   subroutine test1()
  19     integer :: j
  20     real :: arr(5)
  21     integer, pointer :: ipp
  22     real, pointer :: rpp(:)
  23 !ERROR: Must be a constant value
  24     type(parent1) :: tp1 = parent1(3)
  25 !ERROR: Must be a constant value
  26     type(parent1) :: tp2 = parent1(j)
  27     type(parent1) :: tp3 = parent1(null())
  28 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
  29     type(parent1) :: tp4 = parent1(null(ipp))
  30
  31 !ERROR: Must be a constant value
  32     type(parent2) :: tp5 = parent2([1.1,2.1,3.1])
  33 !ERROR: Must be a constant value
  34     type(parent2) :: tp6 = parent2(arr)
  35     type(parent2) :: tp7 = parent2(null())
  36 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
  37     type(parent2) :: tp8 = parent2(null(rpp))
  38   end subroutine test1
  39
  40   subroutine test2()
  41     integer :: j
  42     real :: arr(5)
  43     integer, pointer :: ipp
  44     real, pointer :: rpp(:)
  45     type(parent1) :: tp1
  46     type(parent2) :: tp2
  47     tp1 = parent1(3)
  48     tp1 = parent1(j)
  49     tp1 = parent1(null())
  50 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
  51     tp1 = parent1(null(ipp))
  52
  53     tp2 = parent2([1.1,2.1,3.1])
  54     tp2 = parent2(arr)
  55     tp2 = parent2(null())
  56 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
  57     tp2 = parent2(null(rpp))
  58   end subroutine test2
  59
  60   subroutine test3()
  61     real, pointer :: pp(:)
  62     type(child) :: tc1 = child(5, parent2(null()))
  63 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'pa'
  64     type(child) :: tc10 = child(5, parent2(null(pp)))
  65 !ERROR: Must be a constant value
  66     type(child) :: tc3 = child(5, parent2([1.1,1.2]))
  67     type(child) :: tc4
  68
  69     tc4 = child(5, parent2(null()))
  70     tc4 = child(5, parent2([1.1,1.2]))
  71   end subroutine test3
  72 end module m