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