1! { dg-do compile }
2!
3! Test bad PDT coding: Based on pdt_3.f03
4!
5module m
6  integer :: d_dim = 4
7  integer :: mat_dim = 256
8  integer, parameter :: ftype = kind(0.0d0)
9  type :: modtype (a,b)
10    integer, kind :: a = kind(0.0e0)
11    integer, LEN :: b = 4
12    integer :: i
13    real(kind = a) :: d(b, b)
14  end type
15end module
16
17module bad_vars
18  use m
19  type(modtype(8,mat_dim)) :: mod_q ! { dg-error "must not have the SAVE attribute" }
20  type(modtype(8,*)) :: mod_r       ! { dg-error "ASSUMED type parameters" }
21end module
22
23  use m
24  implicit none
25  integer :: i
26  integer, kind :: bad_kind    ! { dg-error "not allowed outside a TYPE definition" }
27  integer, len :: bad_len      ! { dg-error "not allowed outside a TYPE definition" }
28
29  type :: bad_pdt (a,b, c, d)  ! { dg-error "does not have a component" }
30    real, kind :: a            ! { dg-error "must be INTEGER" }
31    INTEGER(8), kind :: b      ! { dg-error "be default integer kind" }
32    real, LEN :: c             ! { dg-error "must be INTEGER" }
33    INTEGER(8), LEN :: d       ! { dg-error "be default integer kind" }
34  end type
35
36  type :: mytype (a,b)
37    integer, kind :: a = kind(0.0e0)
38    integer, LEN :: b = 4
39    integer :: i
40    real(kind = a) :: d(b, b)
41  end type
42
43  type, extends(mytype) :: thytype(h)
44    integer, kind :: h
45    integer(kind = h) :: j
46  end type
47
48  type x (q, r, s)
49    integer, kind :: q
50    integer, kind :: r
51    integer, LEN :: s
52    integer(kind = q) :: idx_mat(2,2)
53    type (mytype (b=s)) :: mat1
54    type (mytype (b=s*2)) :: mat2
55  end type x
56
57  real, allocatable :: matrix (:,:)
58
59! Bad KIND parameters
60  type(thytype(d_dim, 4, 4)) :: wbad ! { dg-error "does not reduce to a constant" }
61  type(thytype(*, 4, 4)) :: worse    ! { dg-error "cannot either be ASSUMED or DEFERRED" }
62  type(thytype(:, 4, 4)) :: w_ugh    ! { dg-error "cannot either be ASSUMED or DEFERRED" }
63
64  type(thytype(ftype, b=4, h=4)) :: w
65  type(x(8,4,mat_dim)) :: q          ! { dg-error "must not have the SAVE attribute" }
66  class(mytype(ftype, :)), allocatable :: cz
67
68  w%a = 1                           ! { dg-error "assignment to a KIND or LEN component" }
69  w%b = 2                           ! { dg-error "assignment to a KIND or LEN component" }
70  w%h = 3                           ! { dg-error "assignment to a KIND or LEN component" }
71
72  w%d = reshape ([(real(i), i = 1, d_dim*d_dim)],[d_dim,d_dim])
73
74  matrix = w%d
75
76  allocate (cz, source = mytype(*, d_dim, 0, matrix)) ! { dg-error "Syntax error" }
77  allocate (cz, source = mytype(ftype, :, 0, matrix)) ! { dg-error "Syntax error" }
78  select type (cz)
79    type is (mytype(ftype, d_dim))  ! { dg-error "must be ASSUMED" }
80      if (int (sum (cz%d)) .ne. 136) STOP 1! { dg-error "Expected TYPE IS" }
81    type is (thytype(ftype, *, 8))
82      STOP 2
83  end select
84  deallocate (cz)
85
86  allocate (thytype(ftype, d_dim*2, 8) :: cz)
87  cz%d = reshape ([(i*10, i = 1, cz%b**2)], [cz%b,cz%b])
88  select type (cz)
89    type is (mytype(4, *))        !  { dg-error "must be an extension" }
90      STOP 3
91    type is (thytype(ftype, *, 8))
92      if (int (sum (cz%d)) .ne. 20800) STOP 4
93  end select
94  deallocate (cz)
95contains
96  subroutine foo(arg)
97    type (mytype(4, *)) :: arg      ! OK
98  end subroutine
99  subroutine bar(arg)               ! { dg-error "is neither allocatable nor a pointer" }
100    type (thytype(8, :, 4)) :: arg
101  end subroutine
102  subroutine foobar(arg)            ! OK
103    type (thytype(8, *, 4)) :: arg
104  end subroutine
105end
106