1! { dg-do compile }
2! { dg-options "-w" }
3subroutine not_an_f03_intrinsic
4
5   implicit none
6
7   byte, allocatable :: x, y(:)
8   real*8, allocatable :: x8, y8(:)
9   double complex :: z
10
11   type real_type
12      integer mytype
13   end type real_type
14
15   type(real_type), allocatable :: b, c(:)
16
17   allocate(byte :: x)            ! { dg-error "Error in type-spec at" }
18   allocate(byte :: y(1))         ! { dg-error "Error in type-spec at" }
19
20   allocate(real*8 :: x)          ! { dg-error "Invalid type-spec at" }
21   allocate(real*8 :: y(1))       ! { dg-error "Invalid type-spec at" }
22   allocate(real*4 :: x8)         ! { dg-error "Invalid type-spec at" }
23   allocate(real*4 :: y8(1))      ! { dg-error "Invalid type-spec at" }
24   allocate(double complex :: d1) ! { dg-error "neither a data pointer nor an allocatable" }
25   allocate(real_type :: b)
26   allocate(real_type :: c(1))
27
28end subroutine not_an_f03_intrinsic
29