comparison gcc/testsuite/gfortran.dg/move_alloc_10.f90 @ 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
20 class(base_type), allocatable, intent(inout) :: a 20 class(base_type), allocatable, intent(inout) :: a
21 type(extended_type), allocatable :: tmp 21 type(extended_type), allocatable :: tmp
22 22
23 allocate (tmp) 23 allocate (tmp)
24 24
25 if (tmp%i /= 2 .or. tmp%j /= 77) call abort() 25 if (tmp%i /= 2 .or. tmp%j /= 77) STOP 1
26 tmp%i = 5 26 tmp%i = 5
27 tmp%j = 88 27 tmp%j = 88
28 28
29 select type(a) 29 select type(a)
30 type is(base_type) 30 type is(base_type)
31 if (a%i /= -44) call abort() 31 if (a%i /= -44) STOP 2
32 a%i = -99 32 a%i = -99
33 class default 33 class default
34 call abort () 34 STOP 3
35 end select 35 end select
36 36
37 call move_alloc (from=tmp, to=a) 37 call move_alloc (from=tmp, to=a)
38 38
39 select type(a) 39 select type(a)
40 type is(extended_type) 40 type is(extended_type)
41 if (a%i /= 5) call abort() 41 if (a%i /= 5) STOP 4
42 if (a%j /= 88) call abort() 42 if (a%j /= 88) STOP 5
43 a%i = 123 43 a%i = 123
44 a%j = 9498 44 a%j = 9498
45 class default 45 class default
46 call abort () 46 STOP 6
47 end select 47 end select
48 48
49 if (allocated (tmp)) call abort() 49 if (allocated (tmp)) STOP 7
50 end subroutine myallocate 50 end subroutine myallocate
51 end module myalloc 51 end module myalloc
52 52
53 program main 53 program main
54 use myalloc 54 use myalloc
57 57
58 allocate (a) 58 allocate (a)
59 59
60 select type(a) 60 select type(a)
61 type is(base_type) 61 type is(base_type)
62 if (a%i /= 2) call abort() 62 if (a%i /= 2) STOP 8
63 a%i = -44 63 a%i = -44
64 class default 64 class default
65 call abort () 65 STOP 9
66 end select 66 end select
67 67
68 call myallocate (a) 68 call myallocate (a)
69 69
70 select type(a) 70 select type(a)
71 type is(extended_type) 71 type is(extended_type)
72 if (a%i /= 123) call abort() 72 if (a%i /= 123) STOP 10
73 if (a%j /= 9498) call abort() 73 if (a%j /= 9498) STOP 11
74 class default 74 class default
75 call abort () 75 STOP 12
76 end select 76 end select
77 end program main 77 end program main