1! { dg-do run }
2! { dg-additional-sources assumed_rank_8_c.c }
3!
4! PR fortran/48820
5!
6! Scalars to assumed-rank tests
7!
8program main
9  implicit none
10
11  type t
12    integer :: i
13  end type t
14
15  interface
16    subroutine check (x)
17      integer :: x(..)
18    end subroutine check
19    subroutine check2 (x)
20      import t
21      class(t) :: x(..)
22    end subroutine check2
23  end interface
24
25  integer :: j
26
27  type(t), target :: y
28  class(t), allocatable, target :: yac
29
30  y%i = 489
31  allocate (yac)
32  yac%i = 489
33  j = 0
34  call fc()
35  call fc(null())
36  call fc(y)
37  call fc(yac)
38  if (j /= 2) call abort ()
39
40  j = 0
41  call gc(null())
42  call gc(y)
43  call gc(yac)
44  deallocate (yac)
45  call gc(yac)
46  if (j /= 2) call abort ()
47
48  j = 0
49  call hc(yac)
50  allocate (yac)
51  yac%i = 489
52  call hc(yac)
53  if (j /= 1) call abort ()
54
55  j = 0
56  call ft()
57  call ft(null())
58  call ft(y)
59  call ft(yac)
60  if (j /= 2) call abort ()
61
62  j = 0
63  call gt(null())
64  call gt(y)
65  call gt(yac)
66  deallocate (yac)
67  call gt(yac)
68  if (j /= 2) call abort ()
69
70  j = 0
71  call ht(yac)
72  allocate (yac)
73  yac%i = 489
74  call ht(yac)
75  if (j /= 1) call abort ()
76
77contains
78
79  subroutine fc (x)
80    class(t), optional :: x(..)
81
82    if (.not. present (x)) return
83    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
84    if (rank (x) /= 0) call abort
85    call check2 (x)
86    j = j + 1
87  end subroutine
88
89  subroutine gc (x)
90    class(t), pointer, intent(in) :: x(..)
91
92    if (.not. associated (x)) return
93    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
94    if (rank (x) /= 0) call abort ()
95    call check2 (x)
96    j = j + 1
97  end subroutine
98
99  subroutine hc (x)
100    class(t), allocatable :: x(..)
101
102    if (.not. allocated (x)) return
103    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
104    if (rank (x) /= 0) call abort
105    call check2 (x)
106    j = j + 1
107  end subroutine
108
109  subroutine ft (x)
110    type(t), optional :: x(..)
111
112    if (.not. present (x)) return
113    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
114    if (rank (x) /= 0) call abort
115    call check2 (x)
116    j = j + 1
117  end subroutine
118
119  subroutine gt (x)
120    type(t), pointer, intent(in) :: x(..)
121
122    if (.not. associated (x)) return
123    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
124    if (rank (x) /= 0) call abort ()
125    call check2 (x)
126    j = j + 1
127  end subroutine
128
129  subroutine ht (x)
130    type(t), allocatable :: x(..)
131
132    if (.not. allocated (x)) return
133    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
134    if (rank (x) /= 0) call abort
135    call check2 (x)
136    j = j + 1
137  end subroutine
138
139end program main
140