annotate gcc/testsuite/gfortran.dg/pointer_array_1.f90 @ 132:d34655255c78

update gcc-8.2
author mir3636
date Thu, 25 Oct 2018 10:21:07 +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 ! Check the fix for PR34640 comments 1 and 3.
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! This involves passing and returning pointer array components that
kono
parents:
diff changeset
6 ! point to components of arrays of derived types.
kono
parents:
diff changeset
7 !
kono
parents:
diff changeset
8 MODULE test
kono
parents:
diff changeset
9 IMPLICIT NONE
kono
parents:
diff changeset
10 TYPE :: my_type
kono
parents:
diff changeset
11 INTEGER :: value
kono
parents:
diff changeset
12 integer :: tag
kono
parents:
diff changeset
13 END TYPE
kono
parents:
diff changeset
14 CONTAINS
kono
parents:
diff changeset
15 SUBROUTINE get_values(values, switch)
kono
parents:
diff changeset
16 INTEGER, POINTER :: values(:)
kono
parents:
diff changeset
17 integer :: switch
kono
parents:
diff changeset
18 TYPE(my_type), POINTER :: d(:)
kono
parents:
diff changeset
19 allocate (d, source = [my_type(1,101), my_type(2,102)])
kono
parents:
diff changeset
20 if (switch .eq. 1) then
kono
parents:
diff changeset
21 values => d(:)%value
kono
parents:
diff changeset
22 if (any (values .ne. [1,2])) print *, values(2)
kono
parents:
diff changeset
23 else
kono
parents:
diff changeset
24 values => d(:)%tag
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
25 if (any (values .ne. [101,102])) STOP 1
111
kono
parents:
diff changeset
26 end if
kono
parents:
diff changeset
27 END SUBROUTINE
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29 function return_values(switch) result (values)
kono
parents:
diff changeset
30 INTEGER, POINTER :: values(:)
kono
parents:
diff changeset
31 integer :: switch
kono
parents:
diff changeset
32 TYPE(my_type), POINTER :: d(:)
kono
parents:
diff changeset
33 allocate (d, source = [my_type(1,101), my_type(2,102)])
kono
parents:
diff changeset
34 if (switch .eq. 1) then
kono
parents:
diff changeset
35 values => d(:)%value
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
36 if (any (values .ne. [1,2])) STOP 2
111
kono
parents:
diff changeset
37 else
kono
parents:
diff changeset
38 values => d(:)%tag
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
39 if (any (values([2,1]) .ne. [102,101])) STOP 3
111
kono
parents:
diff changeset
40 end if
kono
parents:
diff changeset
41 END function
kono
parents:
diff changeset
42 END MODULE
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 use test
kono
parents:
diff changeset
45 integer, pointer :: x(:)
kono
parents:
diff changeset
46 type :: your_type
kono
parents:
diff changeset
47 integer, pointer :: x(:)
kono
parents:
diff changeset
48 end type
kono
parents:
diff changeset
49 type(your_type) :: y
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 call get_values (x, 1)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
52 if (any (x .ne. [1,2])) STOP 4
111
kono
parents:
diff changeset
53 call get_values (y%x, 2)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
54 if (any (y%x .ne. [101,102])) STOP 5
111
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 x => return_values (2)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
57 if (any (x .ne. [101,102])) STOP 6
111
kono
parents:
diff changeset
58 y%x => return_values (1)
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
59 if (any (y%x .ne. [1,2])) STOP 7
111
kono
parents:
diff changeset
60 end