2 ! { dg-options "-fbackslash" }
4 logical, parameter :: bigendian
= transfer ((/1_1,0_1,0_1,0_1/), 0_4) /= 1
6 character(kind
=1,len
=3) :: s1
, t1
, u1
7 character(kind
=4,len
=3) :: s4
, t4
, u4
11 call check_merge1 ("foo", "gee", .true
., .false
.)
12 call check_merge4 (4_
"foo", 4_
"gee", .true
., .false
.)
14 if (merge ("foo", "gee", .true
.) /= "foo") STOP 1
15 if (merge ("foo", "gee", .false
.) /= "gee") STOP 2
16 if (merge (4_
"foo", 4_
"gee", .true
.) /= 4_
"foo") STOP 3
17 if (merge (4_
"foo", 4_
"gee", .false
.) /= 4_
"gee") STOP 4
19 ! Test TRANSFER intrinsic
22 if (transfer (4_
"x", " ") /= "\0\0\0x") STOP 5
24 if (transfer (4_
"x", " ") /= "x\0\0\0") STOP 6
26 if (transfer (4_
"\U44444444", " ") /= "\x44\x44\x44\x44") STOP 7
27 if (transfer (4_
"\U3FE91B5A", 0_4) /= int(z
'3FE91B5A', 4)) STOP 8
29 call check_transfer_i (4_
"\U3FE91B5A", [int(z
'3FE91B5A', 4)])
30 call check_transfer_i (4_
"\u1B5A", [int(z
'1B5A', 4)])
34 subroutine check_merge1 (s1
, t1
, t
, f
)
35 character(kind
=1,len
=*) :: s1
, t1
38 if (merge (s1
, t1
, .true
.) /= s1
) STOP 9
39 if (merge (s1
, t1
, .false
.) /= t1
) STOP 10
40 if (len (merge (s1
, t1
, .true
.)) /= len (s1
)) STOP 11
41 if (len (merge (s1
, t1
, .false
.)) /= len (t1
)) STOP 12
42 if (len_trim (merge (s1
, t1
, .true
.)) /= len_trim (s1
)) STOP 13
43 if (len_trim (merge (s1
, t1
, .false
.)) /= len_trim (t1
)) STOP 14
45 if (merge (s1
, t1
, t
) /= s1
) STOP 15
46 if (merge (s1
, t1
, f
) /= t1
) STOP 16
47 if (len (merge (s1
, t1
, t
)) /= len (s1
)) STOP 17
48 if (len (merge (s1
, t1
, f
)) /= len (t1
)) STOP 18
49 if (len_trim (merge (s1
, t1
, t
)) /= len_trim (s1
)) STOP 19
50 if (len_trim (merge (s1
, t1
, f
)) /= len_trim (t1
)) STOP 20
52 end subroutine check_merge1
54 subroutine check_merge4 (s4
, t4
, t
, f
)
55 character(kind
=4,len
=*) :: s4
, t4
58 if (merge (s4
, t4
, .true
.) /= s4
) STOP 21
59 if (merge (s4
, t4
, .false
.) /= t4
) STOP 22
60 if (len (merge (s4
, t4
, .true
.)) /= len (s4
)) STOP 23
61 if (len (merge (s4
, t4
, .false
.)) /= len (t4
)) STOP 24
62 if (len_trim (merge (s4
, t4
, .true
.)) /= len_trim (s4
)) STOP 25
63 if (len_trim (merge (s4
, t4
, .false
.)) /= len_trim (t4
)) STOP 26
65 if (merge (s4
, t4
, t
) /= s4
) STOP 27
66 if (merge (s4
, t4
, f
) /= t4
) STOP 28
67 if (len (merge (s4
, t4
, t
)) /= len (s4
)) STOP 29
68 if (len (merge (s4
, t4
, f
)) /= len (t4
)) STOP 30
69 if (len_trim (merge (s4
, t4
, t
)) /= len_trim (s4
)) STOP 31
70 if (len_trim (merge (s4
, t4
, f
)) /= len_trim (t4
)) STOP 32
72 end subroutine check_merge4
74 subroutine check_transfer_i (s
, i
)
75 character(kind
=4,len
=*) :: s
76 integer(kind
=4), dimension(len(s
)) :: i
78 if (transfer (s
, 0_4) /= ichar (s(1:1))) STOP 33
79 if (transfer (s
, 0_4) /= i(1)) STOP 34
80 if (any (transfer (s
, [0_4]) /= i
)) STOP 35
81 if (any (transfer (s
, 0_4, len(s
)) /= i
)) STOP 36
83 end subroutine check_transfer_i