1! { dg-do compile }
2!
3! Allocation of arrays with a type-spec specification with implicit none.
4!
5subroutine implicit_none_test1
6
7   implicit none
8
9   real, allocatable :: x(:)
10   real(4), allocatable :: x4(:)
11   real(8), allocatable :: x8(:)
12   double precision, allocatable :: d1(:)
13   doubleprecision, allocatable :: d2(:)
14   character, allocatable :: c1(:)
15
16   type a
17      integer mytype
18   end type a
19
20   type(a), allocatable :: b(:)
21
22   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
23   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
24   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
25   allocate(double :: d1(1))       ! { dg-error "Error in type-spec at" }
26   allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
27   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
28
29end subroutine implicit_none_test1
30!
31! Allocation of a scalar with a type-spec specification with implicit none
32!
33subroutine implicit_none_test2
34
35   implicit none
36
37   real, allocatable :: x
38   real(4), allocatable :: x4
39   real(8), allocatable :: x8
40   double precision, allocatable :: d1
41   character, allocatable :: c1
42
43   type a
44      integer mytype
45   end type a
46
47   type(a), allocatable :: b
48
49   allocate(complex :: x)       ! { dg-error "is type incompatible" }
50   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
51   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
52   allocate(double :: d1)       ! { dg-error "Error in type-spec at" }
53   allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
54   allocate(real :: b)          ! { dg-error "is type incompatible" }
55
56end subroutine implicit_none_test2
57!
58! Allocation of arrays with a type-spec specification with implicit none.
59!
60subroutine implicit_test3
61
62   real, allocatable :: x(:)
63   real(4), allocatable :: x4(:)
64   real(8), allocatable :: x8(:)
65   double precision, allocatable :: d1(:)
66   doubleprecision, allocatable :: d2(:)
67   character, allocatable :: c1(:)
68
69   type a
70      integer mytype
71   end type a
72
73   type(a), allocatable :: b(:)
74
75   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
76   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
77   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
78   allocate(double :: d1(1))       ! { dg-error "Error in type-spec" }
79   allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
80   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
81
82end subroutine implicit_test3
83!
84! Allocation of a scalar with a type-spec specification without implicit none
85!
86subroutine implicit_test4
87
88   real, allocatable :: x
89   real(4), allocatable :: x4
90   real(8), allocatable :: x8
91   double precision, allocatable :: d1
92   character, allocatable :: c1
93
94   type a
95      integer mytype
96   end type a
97
98   type(a), allocatable :: b
99
100   allocate(complex :: x)       ! { dg-error "is type incompatible" }
101   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
102   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
103   allocate(double :: d1)       ! { dg-error "Error in type-spec at" }
104   allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
105   allocate(real :: b)          ! { dg-error "is type incompatible" }
106
107end subroutine implicit_test4
108