1! { dg-do compile}
2!
3! TS 29113
4! C407b  An assumed-type variable name shall not appear in a designator
5! or expression except as an actual argument corresponding to a dummy
6! argument that is assumed-type, or as the first argument to any of
7! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND,
8! PRESENT, RANK, SHAPE, SIZE, UBOUND, and C_LOC.
9!
10! This test file contains tests that are expected to all pass.
11
12! Check that passing an assumed-type variable as an actual argument
13! corresponding to an assumed-type dummy works.
14
15module m
16  interface
17    subroutine g (a, b)
18      implicit none
19      type(*) :: a
20      integer :: b
21    end subroutine
22  end interface
23end module
24
25subroutine s0 (x)
26  use m
27  implicit none
28  type(*) :: x
29
30  call g (x, 1)
31end subroutine
32
33! Check that calls to the permitted intrinsic functions work.
34
35function test_is_contiguous (a)
36  implicit none
37  type(*) :: a(*)
38  logical :: test_is_contiguous
39
40  test_is_contiguous = is_contiguous (a)
41end function
42
43function test_lbound (a)
44  implicit none
45  type(*) :: a(:)
46  integer :: test_lbound
47
48  test_lbound = lbound (a, 1)
49end function
50
51function test_present (a)
52  implicit none
53  type(*), optional :: a(*)
54  logical :: test_present
55
56  test_present = present (a)
57end function
58
59function test_rank (a)
60  implicit none
61  type(*) :: a(*)
62  integer :: test_rank
63
64  test_rank = rank (a)
65end function
66
67function test_shape (a)
68  implicit none
69  type(*) :: a(:)  ! assumed-shape array so shape intrinsic works
70  integer :: test_shape
71
72  integer :: temp, i
73  integer, dimension (rank (a)) :: ashape
74
75  temp = 1
76  ashape = shape (a)
77  do i = 1, rank (a)
78    temp = temp * ashape (i)
79  end do
80  test_shape = temp
81end function
82
83function test_size (a)
84  implicit none
85  type(*) :: a(:)
86  integer :: test_size
87
88  test_size = size (a)
89end function
90
91function test_ubound (a)
92  implicit none
93  type(*) :: a(:)
94  integer :: test_ubound
95
96  test_ubound = ubound (a, 1)
97end function
98
99function test_c_loc (a)
100  use iso_c_binding
101  implicit none
102  type(*), target :: a(*)
103  type(c_ptr) :: test_c_loc
104
105  test_c_loc = c_loc (a)
106end function
107
108