1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
! { 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 ! { dg-error "be default integer kind" }
real, LEN :: c ! { dg-error "must be INTEGER" }
INTEGER(8), LEN :: d ! { dg-error "be default integer kind" }
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) call abort ! { dg-error "Expected TYPE IS" }
type is (thytype(ftype, *, 8))
call abort
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" }
call abort
type is (thytype(ftype, *, 8))
if (int (sum (cz%d)) .ne. 20800) call abort
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
|
