annotate gcc/testsuite/gfortran.dg/mapping_1.f90 @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
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 ! Tests the fix for PR31213, which exposed rather a lot of
kono
parents:
diff changeset
3 ! bugs - see the PR and the ChangeLog.
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
kono
parents:
diff changeset
6 !
kono
parents:
diff changeset
7 module mykinds
kono
parents:
diff changeset
8 implicit none
kono
parents:
diff changeset
9 integer, parameter :: ik1 = selected_int_kind (2)
kono
parents:
diff changeset
10 integer, parameter :: ik2 = selected_int_kind (4)
kono
parents:
diff changeset
11 integer, parameter :: dp = selected_real_kind (15,300)
kono
parents:
diff changeset
12 end module mykinds
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 module spec_xpr
kono
parents:
diff changeset
15 use mykinds
kono
parents:
diff changeset
16 implicit none
kono
parents:
diff changeset
17 integer(ik2) c_size
kono
parents:
diff changeset
18 contains
kono
parents:
diff changeset
19 pure function tricky (str,ugly)
kono
parents:
diff changeset
20 character(*), intent(in) :: str
kono
parents:
diff changeset
21 integer(ik1) :: ia_ik1(len(str))
kono
parents:
diff changeset
22 interface yoagly
kono
parents:
diff changeset
23 pure function ugly(n)
kono
parents:
diff changeset
24 use mykinds
kono
parents:
diff changeset
25 implicit none
kono
parents:
diff changeset
26 integer, intent(in) :: n
kono
parents:
diff changeset
27 complex(dp) :: ugly(3*n+2)
kono
parents:
diff changeset
28 end function ugly
kono
parents:
diff changeset
29 end interface yoagly
kono
parents:
diff changeset
30 logical :: la(size (yoagly (size (ia_ik1))))
kono
parents:
diff changeset
31 integer :: i
kono
parents:
diff changeset
32 character(tricky_helper ((/(.TRUE., i=1, size (la))/)) + c_size) :: tricky
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 tricky = transfer (yoagly (1), tricky)
kono
parents:
diff changeset
35 end function tricky
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 pure function tricky_helper (lb)
kono
parents:
diff changeset
38 logical, intent(in) :: lb(:)
kono
parents:
diff changeset
39 integer :: tricky_helper
kono
parents:
diff changeset
40 tricky_helper = 2 * size (lb) + 3
kono
parents:
diff changeset
41 end function tricky_helper
kono
parents:
diff changeset
42 end module spec_xpr
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 module xtra_fun
kono
parents:
diff changeset
45 implicit none
kono
parents:
diff changeset
46 contains
kono
parents:
diff changeset
47 pure function butt_ugly(n)
kono
parents:
diff changeset
48 use mykinds
kono
parents:
diff changeset
49 implicit none
kono
parents:
diff changeset
50 integer, intent(in) :: n
kono
parents:
diff changeset
51 complex(dp) :: butt_ugly(3*n+2)
kono
parents:
diff changeset
52 real(dp) pi, sq2
kono
parents:
diff changeset
53
kono
parents:
diff changeset
54 pi = 4 * atan (1.0_dp)
kono
parents:
diff changeset
55 sq2 = sqrt (2.0_dp)
kono
parents:
diff changeset
56 butt_ugly = cmplx (pi, sq2, dp)
kono
parents:
diff changeset
57 end function butt_ugly
kono
parents:
diff changeset
58 end module xtra_fun
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 program spec_test
kono
parents:
diff changeset
61 use mykinds
kono
parents:
diff changeset
62 use spec_xpr
kono
parents:
diff changeset
63 use xtra_fun
kono
parents:
diff changeset
64 implicit none
kono
parents:
diff changeset
65 character(54) :: chr
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 c_size = 5
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
68 if (tricky ('Help me', butt_ugly) .ne. transfer (butt_ugly (1), chr)) STOP 1
111
kono
parents:
diff changeset
69 end program spec_test