1#!./perl 2 3print "1..18\n"; 4 5@x = (1, 2, 3); 6if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} 7 8if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";} 9 10if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";} 11 12my $f = 'a'; 13$f = join ',', 'b', $f, 'e'; 14if ($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'; 18if ($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'; 22if ($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} 94