1! { dg-do compile }
2! { dg-additional-options "-fcoarray=single" }
3!
4! TS 29113
5! C407a An assumed-type entity shall be a dummy variable that does not
6! have the ALLOCATABLE, CODIMENSION, INTENT(OUT), POINTER, or VALUE
7! attribute and is not an explicit-shape array.
8!
9! This test file contains tests that are expected to issue diagnostics
10! for invalid code.
11
12! Check that diagnostics are issued when type(*) is used to declare things
13! that are not dummy variables.
14
15subroutine s0 (a)
16  implicit none
17  integer :: a
18
19  integer :: goodlocal
20  type(*) :: badlocal  ! { dg-error "Assumed.type" }
21
22  integer :: goodcommon
23  type(*) :: badcommon  ! { dg-error "Assumed.type" }
24  common /frob/ goodcommon, badcommon
25
26  integer :: goodstatic
27  type(*) :: badstatic  ! { dg-error "Assumed.type" }
28  save goodstatic, badstatic
29
30  block
31    integer :: goodlocal2
32    type(*) :: badlocal2  ! { dg-error "Assumed.type" }
33  end block
34
35end subroutine
36
37module m
38  integer :: goodmodvar
39  type(*) :: badmodvar ! { dg-error "Assumed.type" }
40  save goodmodvar, badmodvar
41
42  type :: t
43    integer :: goodcomponent
44    type(*) :: badcomponent ! { dg-error "Assumed.type" }
45  end type
46end module
47
48! Check that diagnostics are issued when type(*) is used in combination
49! with the forbidden attributes.
50
51subroutine s1 (a) ! { dg-error "Assumed.type" }
52  implicit none
53  type(*), allocatable :: a
54end subroutine
55
56subroutine s2 (b) ! { dg-error "Assumed.type" }
57  implicit none
58  type(*), codimension[*] :: b(:,:)
59end subroutine
60
61subroutine s3 (c) ! { dg-error "Assumed.type" }
62  implicit none
63  type(*), intent(out) :: c
64end subroutine
65
66subroutine s4 (d) ! { dg-error "Assumed.type" }
67  implicit none
68  type(*), pointer :: d
69end subroutine
70
71subroutine s5 (e) ! { dg-error "Assumed.type" }
72  implicit none
73  type(*), value :: e
74end subroutine
75
76! Check that diagnostics are issued when type(*) is used to declare
77! a dummy variable that is an explicit-shape array.
78
79subroutine s6 (n, f) ! { dg-error "Assumed.type" }
80  implicit none
81  integer n
82  type(*) :: f(n,n)
83end subroutine
84
85subroutine s7 (g) ! { dg-error "Assumed.type" }
86  implicit none
87  type(*) :: g(10)
88end subroutine
89