Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/assumed_rank_8.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900 (2017-10-27)
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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)
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
42 contains
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
71 end program main