1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gate# This ok() function is specially written to avoid any concatenation. 9*0Sstevel@tonic-gatemy $test = 1; 10*0Sstevel@tonic-gatesub ok { 11*0Sstevel@tonic-gate my($ok, $name) = @_; 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name; 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gate printf "# Failed test at line %d\n", (caller)[2] unless $ok; 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate $test++; 18*0Sstevel@tonic-gate return $ok; 19*0Sstevel@tonic-gate} 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateprint "1..28\n"; 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gate($a, $b, $c) = qw(foo bar); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gateok("$a" eq "foo", "verifying assign"); 26*0Sstevel@tonic-gateok("$a$b" eq "foobar", "basic concatenation"); 27*0Sstevel@tonic-gateok("$c$a$c" eq "foo", "concatenate undef, fore and aft"); 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gate# Okay, so that wasn't very challenging. Let's go Unicode. 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate{ 32*0Sstevel@tonic-gate # bug id 20000819.004 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate $_ = $dx = "\x{10f2}"; 35*0Sstevel@tonic-gate s/($dx)/$dx$1/; 36*0Sstevel@tonic-gate { 37*0Sstevel@tonic-gate ok($_ eq "$dx$dx","bug id 20000819.004, back"); 38*0Sstevel@tonic-gate } 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate $_ = $dx = "\x{10f2}"; 41*0Sstevel@tonic-gate s/($dx)/$1$dx/; 42*0Sstevel@tonic-gate { 43*0Sstevel@tonic-gate ok($_ eq "$dx$dx","bug id 20000819.004, front"); 44*0Sstevel@tonic-gate } 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate $dx = "\x{10f2}"; 47*0Sstevel@tonic-gate $_ = "\x{10f2}\x{10f2}"; 48*0Sstevel@tonic-gate s/($dx)($dx)/$1$2/; 49*0Sstevel@tonic-gate { 50*0Sstevel@tonic-gate ok($_ eq "$dx$dx","bug id 20000819.004, front and back"); 51*0Sstevel@tonic-gate } 52*0Sstevel@tonic-gate} 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate{ 55*0Sstevel@tonic-gate # bug id 20000901.092 56*0Sstevel@tonic-gate # test that undef left and right of utf8 results in a valid string 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate my $a; 59*0Sstevel@tonic-gate $a .= "\x{1ff}"; 60*0Sstevel@tonic-gate ok($a eq "\x{1ff}", "bug id 20000901.092, undef left"); 61*0Sstevel@tonic-gate $a .= undef; 62*0Sstevel@tonic-gate ok($a eq "\x{1ff}", "bug id 20000901.092, undef right"); 63*0Sstevel@tonic-gate} 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate{ 66*0Sstevel@tonic-gate # ID 20001020.006 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gate "x" =~ /(.)/; # unset $2 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate # Without the fix this 5.7.0 would croak: 71*0Sstevel@tonic-gate # Modification of a read-only value attempted at ... 72*0Sstevel@tonic-gate eval {"$2\x{1234}"}; 73*0Sstevel@tonic-gate ok(!$@, "bug id 20001020.006, left"); 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gate # For symmetry with the above. 76*0Sstevel@tonic-gate eval {"\x{1234}$2"}; 77*0Sstevel@tonic-gate ok(!$@, "bug id 20001020.006, right"); 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gate *pi = \undef; 80*0Sstevel@tonic-gate # This bug existed earlier than the $2 bug, but is fixed with the same 81*0Sstevel@tonic-gate # patch. Without the fix this 5.7.0 would also croak: 82*0Sstevel@tonic-gate # Modification of a read-only value attempted at ... 83*0Sstevel@tonic-gate eval{"$pi\x{1234}"}; 84*0Sstevel@tonic-gate ok(!$@, "bug id 20001020.006, constant left"); 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gate # For symmetry with the above. 87*0Sstevel@tonic-gate eval{"\x{1234}$pi"}; 88*0Sstevel@tonic-gate ok(!$@, "bug id 20001020.006, constant right"); 89*0Sstevel@tonic-gate} 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gatesub beq { use bytes; $_[0] eq $_[1]; } 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gate{ 94*0Sstevel@tonic-gate # concat should not upgrade its arguments. 95*0Sstevel@tonic-gate my($l, $r, $c); 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gate ($l, $r, $c) = ("\x{101}", "\x{fe}", "\x{101}\x{fe}"); 98*0Sstevel@tonic-gate ok(beq($l.$r, $c), "concat utf8 and byte"); 99*0Sstevel@tonic-gate ok(beq($l, "\x{101}"), "right not changed after concat u+b"); 100*0Sstevel@tonic-gate ok(beq($r, "\x{fe}"), "left not changed after concat u+b"); 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gate ($l, $r, $c) = ("\x{fe}", "\x{101}", "\x{fe}\x{101}"); 103*0Sstevel@tonic-gate ok(beq($l.$r, $c), "concat byte and utf8"); 104*0Sstevel@tonic-gate ok(beq($l, "\x{fe}"), "right not changed after concat b+u"); 105*0Sstevel@tonic-gate ok(beq($r, "\x{101}"), "left not changed after concat b+u"); 106*0Sstevel@tonic-gate} 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate{ 109*0Sstevel@tonic-gate my $a; ($a .= 5) . 6; 110*0Sstevel@tonic-gate ok($a == 5, '($a .= 5) . 6 - present since 5.000'); 111*0Sstevel@tonic-gate} 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate{ 114*0Sstevel@tonic-gate # [perl #24508] optree construction bug 115*0Sstevel@tonic-gate sub strfoo { "x" } 116*0Sstevel@tonic-gate my ($x, $y); 117*0Sstevel@tonic-gate $y = ($x = '' . strfoo()) . "y"; 118*0Sstevel@tonic-gate ok( "$x,$y" eq "x,xy", 'figures out correct target' ); 119*0Sstevel@tonic-gate} 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gate{ 122*0Sstevel@tonic-gate # [perl #26905] "use bytes" doesn't apply byte semantics to concatenation 123*0Sstevel@tonic-gate 124*0Sstevel@tonic-gate my $p = "\xB6"; # PILCROW SIGN (ASCII/EBCDIC), 2bytes in UTF-X 125*0Sstevel@tonic-gate my $u = "\x{100}"; 126*0Sstevel@tonic-gate my $b = pack 'a*', "\x{100}"; 127*0Sstevel@tonic-gate my $pu = "\xB6\x{100}"; 128*0Sstevel@tonic-gate my $up = "\x{100}\xB6"; 129*0Sstevel@tonic-gate my $x1 = $p; 130*0Sstevel@tonic-gate my $y1 = $u; 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate use bytes; 133*0Sstevel@tonic-gate ok(beq($p.$u, $p.$b), "perl #26905, left eq bytes"); 134*0Sstevel@tonic-gate ok(beq($u.$p, $b.$p), "perl #26905, right eq bytes"); 135*0Sstevel@tonic-gate ok(!beq($p.$u, $pu), "perl #26905, left ne unicode"); 136*0Sstevel@tonic-gate ok(!beq($u.$p, $up), "perl #26905, right ne unicode"); 137*0Sstevel@tonic-gate 138*0Sstevel@tonic-gate $x1 .= $u; 139*0Sstevel@tonic-gate $x2 = $p . $u; 140*0Sstevel@tonic-gate $y1 .= $p; 141*0Sstevel@tonic-gate $y2 = $u . $p; 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gate no bytes; 144*0Sstevel@tonic-gate ok(beq($x1, $x2), "perl #26905, left, .= vs = . in bytes"); 145*0Sstevel@tonic-gate ok(beq($y1, $y2), "perl #26905, right, .= vs = . in bytes"); 146*0Sstevel@tonic-gate ok(($x1 eq $x2), "perl #26905, left, .= vs = . in chars"); 147*0Sstevel@tonic-gate ok(($y1 eq $y2), "perl #26905, right, .= vs = . in chars"); 148*0Sstevel@tonic-gate} 149