|
111
|
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 !
|
|
|
8 program 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)
|
|
131
|
27 if (j /= 2) STOP 1
|
|
111
|
28
|
|
|
29 j = 0
|
|
|
30 nullify (ll)
|
|
|
31 call g (null())
|
|
|
32 call g (ll)
|
|
|
33 call g (ii)
|
|
131
|
34 if (j /= 1) STOP 2
|
|
111
|
35
|
|
|
36 j = 0
|
|
|
37 call h (kk)
|
|
|
38 kk = 489
|
|
|
39 call h (kk)
|
|
131
|
40 if (j /= 1) STOP 3
|
|
111
|
41
|
|
|
42 contains
|
|
|
43
|
|
|
44 subroutine f (x)
|
|
|
45 integer, optional :: x(..)
|
|
|
46
|
|
|
47 if (.not. present (x)) return
|
|
131
|
48 if (rank (x) /= 0) STOP 1
|
|
111
|
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
|
|
131
|
57 if (rank (x) /= 0) STOP 4
|
|
111
|
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
|
|
131
|
66 if (rank (x) /= 0) STOP 2
|
|
111
|
67 call check (x)
|
|
|
68 j = j + 1
|
|
|
69 end subroutine
|
|
|
70
|
|
|
71 end program main
|
