1! { dg-do run }
2! { dg-options "-fbackslash" }
3
4  logical, parameter :: bigendian = transfer ((/1_1,0_1,0_1,0_1/), 0_4) /= 1
5
6  character(kind=1,len=3) :: s1, t1, u1
7  character(kind=4,len=3) :: s4, t4, u4
8
9  ! Test MERGE intrinsic
10
11  call check_merge1 ("foo", "gee", .true., .false.)
12  call check_merge4 (4_"foo", 4_"gee", .true., .false.)
13
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
18
19  ! Test TRANSFER intrinsic
20
21  if (bigendian) then
22    if (transfer (4_"x", "    ") /= "\0\0\0x") STOP 5
23  else
24    if (transfer (4_"x", "    ") /= "x\0\0\0") STOP 6
25  endif
26  if (transfer (4_"\U44444444", "    ") /= "\x44\x44\x44\x44") STOP 7
27  if (transfer (4_"\U3FE91B5A", 0_4) /= int(z'3FE91B5A', 4)) STOP 8
28
29  call check_transfer_i (4_"\U3FE91B5A", [int(z'3FE91B5A', 4)])
30  call check_transfer_i (4_"\u1B5A", [int(z'1B5A', 4)])
31
32contains
33
34  subroutine check_merge1 (s1, t1, t, f)
35    character(kind=1,len=*) :: s1, t1
36    logical :: t, f
37
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
44
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
51
52  end subroutine check_merge1
53
54  subroutine check_merge4 (s4, t4, t, f)
55    character(kind=4,len=*) :: s4, t4
56    logical :: t, f
57
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
64
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
71
72  end subroutine check_merge4
73
74  subroutine check_transfer_i (s, i)
75    character(kind=4,len=*) :: s
76    integer(kind=4), dimension(len(s)) :: i
77
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
82
83  end subroutine check_transfer_i
84
85end
86