1 | #!./perl |
---|
2 | |
---|
3 | print "1..18\n"; |
---|
4 | |
---|
5 | @x = (1, 2, 3); |
---|
6 | if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} |
---|
7 | |
---|
8 | if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";} |
---|
9 | |
---|
10 | if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";} |
---|
11 | |
---|
12 | my $f = 'a'; |
---|
13 | $f = join ',', 'b', $f, 'e'; |
---|
14 | if ($f eq 'b,a,e') {print "ok 4\n";} else {print "# '$f'\nnot ok 4\n";} |
---|
15 | |
---|
16 | $f = 'a'; |
---|
17 | $f = join ',', $f, 'b', 'e'; |
---|
18 | if ($f eq 'a,b,e') {print "ok 5\n";} else {print "not ok 5\n";} |
---|
19 | |
---|
20 | $f = 'a'; |
---|
21 | $f = join $f, 'b', 'e', 'k'; |
---|
22 | if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";} |
---|
23 | |
---|
24 | # 7,8 check for multiple read of tied objects |
---|
25 | { package X; |
---|
26 | sub TIESCALAR { my $x = 7; bless \$x }; |
---|
27 | sub FETCH { my $y = shift; $$y += 5 }; |
---|
28 | tie my $t, 'X'; |
---|
29 | my $r = join ':', $t, 99, $t, 99; |
---|
30 | print "# expected '12:99:17:99' got '$r'\nnot " if $r ne '12:99:17:99'; |
---|
31 | print "ok 7\n"; |
---|
32 | $r = join '', $t, 99, $t, 99; |
---|
33 | print "# expected '22992799' got '$r'\nnot " if $r ne '22992799'; |
---|
34 | print "ok 8\n"; |
---|
35 | }; |
---|
36 | |
---|
37 | # 9,10 and for multiple read of undef |
---|
38 | { my $s = 5; |
---|
39 | local ($^W, $SIG{__WARN__}) = ( 1, sub { $s+=4 } ); |
---|
40 | my $r = join ':', 'a', undef, $s, 'b', undef, $s, 'c'; |
---|
41 | print "# expected 'a::9:b::13:c' got '$r'\nnot " if $r ne 'a::9:b::13:c'; |
---|
42 | print "ok 9\n"; |
---|
43 | my $r = join '', 'a', undef, $s, 'b', undef, $s, 'c'; |
---|
44 | print "# expected 'a17b21c' got '$r'\nnot " if $r ne 'a17b21c'; |
---|
45 | print "ok 10\n"; |
---|
46 | }; |
---|
47 | |
---|
48 | { my $s = join("", chr(0x1234), chr(0xff)); |
---|
49 | print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}"; |
---|
50 | print "ok 11\n"; |
---|
51 | } |
---|
52 | |
---|
53 | { my $s = join(chr(0xff), chr(0x1234), ""); |
---|
54 | print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}"; |
---|
55 | print "ok 12\n"; |
---|
56 | } |
---|
57 | |
---|
58 | { my $s = join(chr(0x1234), chr(0xff), chr(0x2345)); |
---|
59 | print "not " unless length($s) == 3 && $s eq "\x{ff}\x{1234}\x{2345}"; |
---|
60 | print "ok 13\n"; |
---|
61 | } |
---|
62 | |
---|
63 | { my $s = join(chr(0xff), chr(0x1234), chr(0xfe)); |
---|
64 | print "not " unless length($s) == 3 && $s eq "\x{1234}\x{ff}\x{fe}"; |
---|
65 | print "ok 14\n"; |
---|
66 | } |
---|
67 | |
---|
68 | { # [perl #24846] $jb2 should be in bytes, not in utf8. |
---|
69 | my $b = "abc\304"; |
---|
70 | my $u = "abc\x{0100}"; |
---|
71 | |
---|
72 | sub join_into_my_variable { |
---|
73 | my $r = join("", @_); |
---|
74 | return $r; |
---|
75 | } |
---|
76 | |
---|
77 | my $jb1 = join_into_my_variable("", $b); |
---|
78 | my $ju1 = join_into_my_variable("", $u); |
---|
79 | my $jb2 = join_into_my_variable("", $b); |
---|
80 | my $ju2 = join_into_my_variable("", $u); |
---|
81 | |
---|
82 | print "not " unless unpack('H*', $jb1) eq unpack('H*', $b); |
---|
83 | print "ok 15\n"; |
---|
84 | |
---|
85 | print "not " unless unpack('H*', $ju1) eq unpack('H*', $u); |
---|
86 | print "ok 16\n"; |
---|
87 | |
---|
88 | print "not " unless unpack('H*', $jb2) eq unpack('H*', $b); |
---|
89 | print "ok 17\n"; |
---|
90 | |
---|
91 | print "not " unless unpack('H*', $ju2) eq unpack('H*', $u); |
---|
92 | print "ok 18\n"; |
---|
93 | } |
---|