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