1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
# This ok() function is specially written to avoid any concatenation.
my $test = 1;
sub ok {
my($ok, $name) = @_;
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name;
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}
print "1..19\n";
($a, $b, $c) = qw(foo bar);
ok("$a" eq "foo", "verifying assign");
ok("$a$b" eq "foobar", "basic concatenation");
ok("$c$a$c" eq "foo", "concatenate undef, fore and aft");
# Okay, so that wasn't very challenging. Let's go Unicode.
{
# bug id 20000819.004
$_ = $dx = "\x{10f2}";
s/($dx)/$dx$1/;
{
ok($_ eq "$dx$dx","bug id 20000819.004, back");
}
$_ = $dx = "\x{10f2}";
s/($dx)/$1$dx/;
{
ok($_ eq "$dx$dx","bug id 20000819.004, front");
}
$dx = "\x{10f2}";
$_ = "\x{10f2}\x{10f2}";
s/($dx)($dx)/$1$2/;
{
ok($_ eq "$dx$dx","bug id 20000819.004, front and back");
}
}
{
# bug id 20000901.092
# test that undef left and right of utf8 results in a valid string
my $a;
$a .= "\x{1ff}";
ok($a eq "\x{1ff}", "bug id 20000901.092, undef left");
$a .= undef;
ok($a eq "\x{1ff}", "bug id 20000901.092, undef right");
}
{
# ID 20001020.006
"x" =~ /(.)/; # unset $2
# Without the fix this 5.7.0 would croak:
# Modification of a read-only value attempted at ...
eval {"$2\x{1234}"};
ok(!$@, "bug id 20001020.006, left");
# For symmetry with the above.
eval {"\x{1234}$2"};
ok(!$@, "bug id 20001020.006, right");
*pi = \undef;
# This bug existed earlier than the $2 bug, but is fixed with the same
# patch. Without the fix this 5.7.0 would also croak:
# Modification of a read-only value attempted at ...
eval{"$pi\x{1234}"};
ok(!$@, "bug id 20001020.006, constant left");
# For symmetry with the above.
eval{"\x{1234}$pi"};
ok(!$@, "bug id 20001020.006, constant right");
}
sub beq { use bytes; $_[0] eq $_[1]; }
{
# concat should not upgrade its arguments.
my($l, $r, $c);
($l, $r, $c) = ("\x{101}", "\x{fe}", "\x{101}\x{fe}");
ok(beq($l.$r, $c), "concat utf8 and byte");
ok(beq($l, "\x{101}"), "right not changed after concat u+b");
ok(beq($r, "\x{fe}"), "left not changed after concat u+b");
($l, $r, $c) = ("\x{fe}", "\x{101}", "\x{fe}\x{101}");
ok(beq($l.$r, $c), "concat byte and utf8");
ok(beq($l, "\x{fe}"), "right not changed after concat b+u");
ok(beq($r, "\x{101}"), "left not changed after concat b+u");
}
{
my $a; ($a .= 5) . 6;
ok($a == 5, '($a .= 5) . 6 - present since 5.000');
}
|
