Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/class_array_2.f03 @ 132:d34655255c78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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)