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