Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/assumed_rank_7.f90 @ 158:494b0b89df80 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 !
kono
parents:
diff changeset
3 ! PR fortran/48820
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! Handle type/class for assumed-rank arrays
kono
parents:
diff changeset
6 !
kono
parents:
diff changeset
7 ! FIXME: Passing a CLASS to a CLASS has to be re-enabled.
kono
parents:
diff changeset
8 implicit none
kono
parents:
diff changeset
9 type t
kono
parents:
diff changeset
10 integer :: i
kono
parents:
diff changeset
11 end type
kono
parents:
diff changeset
12
kono
parents:
diff changeset
13 class(T), allocatable :: ac(:,:)
kono
parents:
diff changeset
14 type(T), allocatable :: at(:,:)
kono
parents:
diff changeset
15 integer :: i
kono
parents:
diff changeset
16
kono
parents:
diff changeset
17 allocate(ac(2:3,2:4))
kono
parents:
diff changeset
18 allocate(at(2:3,2:4))
kono
parents:
diff changeset
19
kono
parents:
diff changeset
20 i = 0
kono
parents:
diff changeset
21 call foo(ac)
kono
parents:
diff changeset
22 call foo(at)
kono
parents:
diff changeset
23 call bar(ac)
kono
parents:
diff changeset
24 call bar(at)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
25 if (i /= 12) STOP 1
111
kono
parents:
diff changeset
26
kono
parents:
diff changeset
27 contains
kono
parents:
diff changeset
28 subroutine bar(x)
kono
parents:
diff changeset
29 type(t) :: x(..)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
30 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 2
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
31 if (size(x) /= 6) STOP 3
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
32 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 4
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
33 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 5
111
kono
parents:
diff changeset
34 i = i + 1
kono
parents:
diff changeset
35 call foo(x)
kono
parents:
diff changeset
36 call bar2(x)
kono
parents:
diff changeset
37 end subroutine
kono
parents:
diff changeset
38 subroutine bar2(x)
kono
parents:
diff changeset
39 type(t) :: x(..)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
40 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 6
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
41 if (size(x) /= 6) STOP 7
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
42 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 8
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
43 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 9
111
kono
parents:
diff changeset
44 i = i + 1
kono
parents:
diff changeset
45 end subroutine
kono
parents:
diff changeset
46 subroutine foo(x)
kono
parents:
diff changeset
47 class(t) :: x(..)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
48 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 10
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
49 if (size(x) /= 6) STOP 11
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
50 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 12
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
51 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 13
111
kono
parents:
diff changeset
52 i = i + 1
kono
parents:
diff changeset
53 call foo2(x)
kono
parents:
diff changeset
54 ! call bar2(x) ! Passing a CLASS to a TYPE does not yet work
kono
parents:
diff changeset
55 end subroutine
kono
parents:
diff changeset
56 subroutine foo2(x)
kono
parents:
diff changeset
57 class(t) :: x(..)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
58 if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) STOP 14
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
59 if (size(x) /= 6) STOP 15
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
60 if (size(x,1) /= 2 .or. size(x,2) /= 3) STOP 16
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
61 if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) STOP 17
111
kono
parents:
diff changeset
62 i = i + 1
kono
parents:
diff changeset
63 end subroutine
kono
parents:
diff changeset
64 end