PR tree-optimization/86415 - strlen() not folded for substrings within constant arrays
[official-gcc.git] / gcc / testsuite / gfortran.dg / pdt_3.f03
blobe364eeae6dfc0ab3ec765088c9a51ace72e421d5
1 ! { dg-do run }
3 ! Check PDT type extension and simple OOP.
5 module vars
6   integer :: d_dim = 4
7   integer :: mat_dim = 256
8   integer, parameter :: ftype = kind(0.0d0)
9 end module
11   use vars
12   implicit none
13   integer :: i
14   type :: mytype (a,b)
15     integer, kind :: a = kind(0.0e0)
16     integer, LEN :: b = 4
17     integer :: i
18     real(kind = a) :: d(b, b)
19   end type
21   type, extends(mytype) :: thytype(h)
22     integer, kind :: h
23     integer(kind = h) :: j
24   end type
26   type x (q, r, s)
27     integer, kind :: q
28     integer, kind :: r
29     integer, LEN :: s
30     integer(kind = q) :: idx_mat(2,2)  ! check these do not get treated as pdt_arrays.
31     type (mytype (b=s)) :: mat1
32     type (mytype (b=s*2)) :: mat2
33   end type x
35   real, allocatable :: matrix (:,:)
36   type(thytype(ftype, 4, 4)) :: w
37   type(x(8,4,256)) :: q
38   class(mytype(ftype, :)), allocatable :: cz
40   w%d = reshape ([(real(i), i = 1, d_dim*d_dim)],[d_dim,d_dim])
42 ! Make sure that the type extension is ordering the parameters correctly.
43   if (w%a .ne. ftype) STOP 1
44   if (w%b .ne. 4) STOP 2
45   if (w%h .ne. 4) STOP 3
46   if (size (w%d) .ne. 16) STOP 4
47   if (int (w%d(2,4)) .ne. 14) STOP 5
48   if (kind (w%j) .ne. w%h) STOP 6
50 ! As a side issue, ensure PDT components are OK
51   if (q%mat1%b .ne. q%s) STOP 7
52   if (q%mat2%b .ne. q%s*2) STOP 8
53   if (size (q%mat1%d) .ne. mat_dim**2) STOP 9
54   if (size (q%mat2%d) .ne. 4*mat_dim**2) STOP 10
56 ! Now check some basic OOP with PDTs
57   matrix = w%d
59 ! TODO - for some reason, using w%d directly in the source causes a seg fault.
60   allocate (cz, source = mytype(ftype, d_dim, 0, matrix))
61   select type (cz)
62     type is (mytype(ftype, *))
63       if (int (sum (cz%d)) .ne. 136) STOP 11
64     type is (thytype(ftype, *, 8))
65       STOP 12
66   end select
67   deallocate (cz)
69   allocate (thytype(ftype, d_dim*2, 8) :: cz)
70   cz%d = reshape ([(i*10, i = 1, cz%b**2)], [cz%b,cz%b])
71   select type (cz)
72     type is (mytype(ftype, *))
73       STOP 13
74     type is (thytype(ftype, *, 8))
75       if (int (sum (cz%d)) .ne. 20800) STOP 14
76   end select
78   deallocate (cz)
79 end