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