Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/class_array_2.f03 @ 132:d34655255c78
update gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 10:21:07 +0900 |
parents | 84e7813d76e9 |
children |
comparison
equal
deleted
inserted
replaced
130:e108057fa461 | 132:d34655255c78 |
---|---|
19 | 19 |
20 allocate(x(1:4), source = [(type2(i,42.0 + float (i)), i = 1, 4)]) | 20 allocate(x(1:4), source = [(type2(i,42.0 + float (i)), i = 1, 4)]) |
21 call display(x, [1], [4], t2 = [(type2(i,42.0 + float (i)), i = 1, 4)]) | 21 call display(x, [1], [4], t2 = [(type2(i,42.0 + float (i)), i = 1, 4)]) |
22 call display(x, [1], [4], t2 = [(type2(111,99.0), i = 1, 4)]) | 22 call display(x, [1], [4], t2 = [(type2(111,99.0), i = 1, 4)]) |
23 | 23 |
24 if (any (disp (x) .ne. [99.0,99.0,99.0,99.0])) call abort | 24 if (any (disp (x) .ne. [99.0,99.0,99.0,99.0])) STOP 1 |
25 | 25 |
26 if (associated (x)) deallocate (x) | 26 if (associated (x)) deallocate (x) |
27 | 27 |
28 allocate(x(1:4), source = type1(42)) | 28 allocate(x(1:4), source = type1(42)) |
29 call display(x, [1], [4], t1 = [(type1(42), i = 1, 4)]) | 29 call display(x, [1], [4], t1 = [(type1(42), i = 1, 4)]) |
30 call display(x, [1], [4], t1 = [type1(42),type1(99),type1(42),type1(42)]) | 30 call display(x, [1], [4], t1 = [type1(42),type1(99),type1(42),type1(42)]) |
31 if (any (disp (x) .ne. [0.0,0.0,0.0,0.0])) call abort | 31 if (any (disp (x) .ne. [0.0,0.0,0.0,0.0])) STOP 2 |
32 | 32 |
33 if (associated (x)) deallocate (x) | 33 if (associated (x)) deallocate (x) |
34 | 34 |
35 contains | 35 contains |
36 subroutine display(x, lower, upper, t1, t2) | 36 subroutine display(x, lower, upper, t1, t2) |
39 type(type1), optional, dimension(:) :: t1 | 39 type(type1), optional, dimension(:) :: t1 |
40 type(type2), optional, dimension(:) :: t2 | 40 type(type2), optional, dimension(:) :: t2 |
41 select type (x) | 41 select type (x) |
42 type is (type1) | 42 type is (type1) |
43 if (present (t1)) then | 43 if (present (t1)) then |
44 if (any (x%i .ne. t1%i)) call abort | 44 if (any (x%i .ne. t1%i)) STOP 3 |
45 else | 45 else |
46 call abort | 46 STOP 4 |
47 end if | 47 end if |
48 x(2)%i = 99 | 48 x(2)%i = 99 |
49 type is (type2) | 49 type is (type2) |
50 if (present (t2)) then | 50 if (present (t2)) then |
51 if (any (x%i .ne. t2%i)) call abort | 51 if (any (x%i .ne. t2%i)) STOP 5 |
52 if (any (x%r .ne. t2%r)) call abort | 52 if (any (x%r .ne. t2%r)) STOP 6 |
53 else | 53 else |
54 call abort | 54 STOP 7 |
55 end if | 55 end if |
56 x%i = 111 | 56 x%i = 111 |
57 x%r = 99.0 | 57 x%r = 99.0 |
58 end select | 58 end select |
59 call bounds (x, lower, upper) | 59 call bounds (x, lower, upper) |
60 end subroutine | 60 end subroutine |
61 subroutine bounds (x, lower, upper) | 61 subroutine bounds (x, lower, upper) |
62 class(type1), pointer, dimension (:) :: x | 62 class(type1), pointer, dimension (:) :: x |
63 integer, dimension (:) :: lower, upper | 63 integer, dimension (:) :: lower, upper |
64 if (any (lower .ne. lbound (x))) call abort | 64 if (any (lower .ne. lbound (x))) STOP 8 |
65 if (any (upper .ne. ubound (x))) call abort | 65 if (any (upper .ne. ubound (x))) STOP 9 |
66 end subroutine | 66 end subroutine |
67 elemental function disp(y) result(ans) | 67 elemental function disp(y) result(ans) |
68 class(type1), intent(in) :: y | 68 class(type1), intent(in) :: y |
69 real :: ans | 69 real :: ans |
70 select type (y) | 70 select type (y) |