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  interface
12    subroutine check (x)
13      integer :: x(..)
14    end subroutine check
15  end interface
16
17  integer, target :: ii, j
18  integer, allocatable :: kk
19  integer, pointer :: ll
20  ii = 489
21  j = 0
22  call f (ii)
23  call f (489)
24  call f ()
25  call f (null())
26  call f (kk)
27  if (j /= 2) call abort()
28
29  j = 0
30  nullify (ll)
31  call g (null())
32  call g (ll)
33  call g (ii)
34  if (j /= 1) call abort()
35
36  j = 0
37  call h (kk)
38  kk = 489
39  call h (kk)
40  if (j /= 1) call abort()
41
42contains
43
44  subroutine f (x)
45    integer, optional :: x(..)
46
47    if (.not. present (x)) return
48    if (rank (x) /= 0) call abort
49    call check (x)
50    j = j + 1
51  end subroutine
52
53  subroutine g (x)
54    integer, pointer, intent(in) :: x(..)
55
56    if (.not. associated (x)) return
57    if (rank (x) /= 0) call abort ()
58    call check (x)
59    j = j + 1
60  end subroutine
61
62  subroutine h (x)
63    integer, allocatable :: x(..)
64
65    if (.not. allocated (x)) return
66    if (rank (x) /= 0) call abort
67    call check (x)
68    j = j + 1
69  end subroutine
70
71end program main
72