! { dg-do compile } ! ! Test bad PDT coding: Based on pdt_3.f03 ! module m integer :: d_dim = 4 integer :: mat_dim = 256 integer, parameter :: ftype = kind(0.0d0) type :: modtype (a,b) integer, kind :: a = kind(0.0e0) integer, LEN :: b = 4 integer :: i real(kind = a) :: d(b, b) end type end module module bad_vars use m type(modtype(8,mat_dim)) :: mod_q ! { dg-error "must not have the SAVE attribute" } type(modtype(8,*)) :: mod_r ! { dg-error "ASSUMED type parameters" } end module use m implicit none integer :: i integer, kind :: bad_kind ! { dg-error "not allowed outside a TYPE definition" } integer, len :: bad_len ! { dg-error "not allowed outside a TYPE definition" } type :: bad_pdt (a,b, c, d) ! { dg-error "does not have a component" } real, kind :: a ! { dg-error "must be INTEGER" } INTEGER(8), kind :: b real, LEN :: c ! { dg-error "must be INTEGER" } INTEGER(8), LEN :: d end type type :: mytype (a,b) integer, kind :: a = kind(0.0e0) integer, LEN :: b = 4 integer :: i real(kind = a) :: d(b, b) end type type, extends(mytype) :: thytype(h) integer, kind :: h integer(kind = h) :: j end type type x (q, r, s) integer, kind :: q integer, kind :: r integer, LEN :: s integer(kind = q) :: idx_mat(2,2) type (mytype (b=s)) :: mat1 type (mytype (b=s*2)) :: mat2 end type x real, allocatable :: matrix (:,:) ! Bad KIND parameters type(thytype(d_dim, 4, 4)) :: wbad ! { dg-error "does not reduce to a constant" } type(thytype(*, 4, 4)) :: worse ! { dg-error "cannot either be ASSUMED or DEFERRED" } type(thytype(:, 4, 4)) :: w_ugh ! { dg-error "cannot either be ASSUMED or DEFERRED" } type(thytype(ftype, b=4, h=4)) :: w type(x(8,4,mat_dim)) :: q ! { dg-error "must not have the SAVE attribute" } class(mytype(ftype, :)), allocatable :: cz w%a = 1 ! { dg-error "assignment to a KIND or LEN component" } w%b = 2 ! { dg-error "assignment to a KIND or LEN component" } w%h = 3 ! { dg-error "assignment to a KIND or LEN component" } w%d = reshape ([(real(i), i = 1, d_dim*d_dim)],[d_dim,d_dim]) matrix = w%d allocate (cz, source = mytype(*, d_dim, 0, matrix)) ! { dg-error "Syntax error" } allocate (cz, source = mytype(ftype, :, 0, matrix)) ! { dg-error "Syntax error" } select type (cz) type is (mytype(ftype, d_dim)) ! { dg-error "must be ASSUMED" } if (int (sum (cz%d)) .ne. 136) STOP 1! { dg-error "Expected TYPE IS" } type is (thytype(ftype, *, 8)) STOP 2 end select deallocate (cz) allocate (thytype(ftype, d_dim*2, 8) :: cz) cz%d = reshape ([(i*10, i = 1, cz%b**2)], [cz%b,cz%b]) select type (cz) type is (mytype(4, *)) ! { dg-error "must be an extension" } STOP 3 type is (thytype(ftype, *, 8)) if (int (sum (cz%d)) .ne. 20800) STOP 4 end select deallocate (cz) contains subroutine foo(arg) type (mytype(4, *)) :: arg ! OK end subroutine subroutine bar(arg) ! { dg-error "is neither allocatable nor a pointer" } type (thytype(8, :, 4)) :: arg end subroutine subroutine foobar(arg) ! OK type (thytype(8, *, 4)) :: arg end subroutine end