1! { dg-do compile}
2!
3! TS 29113
4! C407a An assumed-type entity shall be a dummy variable that does not
5! have the ALLOCATABLE, CODIMENSION, INTENT(OUT), POINTER, or VALUE
6! attribute and is not an explicit-shape array.
7!
8! This test file contains tests that are expected to all pass.
9
10! Check basic usage with no attributes.
11
12module m
13  interface
14    subroutine g (a, b)
15      implicit none
16      type(*) :: a
17      integer :: b
18    end subroutine
19  end interface
20end module
21
22subroutine s0 (x)
23  use m
24  implicit none
25  type(*) :: x
26
27  call g (x, 1)
28end subroutine
29
30! Check that other attributes that can normally apply to dummy variables
31! are allowed.
32
33subroutine s1 (a, b, c, d, e, f, g, h)
34  implicit none
35  type(*), asynchronous :: a
36  type(*), contiguous :: b(:,:)
37  type(*), dimension (:) :: c
38  type(*), intent(in) :: d
39  type(*), intent(inout) :: e
40  type(*), optional :: f
41  type(*), target :: g
42  type(*), volatile :: h
43
44end subroutine
45
46! Check that non-explicit-shape arrays are allowed.
47
48subroutine s2 (a, b, c)
49  implicit none
50  type(*) :: a(:)  ! assumed-shape
51  type(*) :: b(*)  ! assumed-size
52  type(*) :: c(..) ! assumed-rank
53
54end subroutine
55
56