diff options
author | James E Keenan <jkeenan@cpan.org> | 2012-12-02 08:11:13 -0500 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2012-12-07 20:05:00 -0500 |
commit | 8a5eedb005f7c37f37bea546d40741b5a9ccfad2 (patch) | |
tree | e0622cd951f9cea9c1c8789b3f7d47452f2a079a /t/op/concat.t | |
parent | 2f445b24d1fcccfa186e5ac8cd8f82a820c4369d (diff) | |
download | perl-8a5eedb005f7c37f37bea546d40741b5a9ccfad2.tar.gz |
Create subdirectory t/opbasic. Move 5 test files there.
t/opbasic will hold files formerly held in t/op but which, unlike the vast
majority of tests in the latter directory, are ineligible to use t/test.pl as
a source of test functions. Affected files:
arith.t
cmp.t
concat.t
magic_phase.t
qq.t
This commit does nothing more than create the new subdirectory and move the
files into it.
For: RT #115838
Diffstat (limited to 't/op/concat.t')
-rw-r--r-- | t/op/concat.t | 161 |
1 files changed, 0 insertions, 161 deletions
diff --git a/t/op/concat.t b/t/op/concat.t deleted file mode 100644 index e2e2c667dc..0000000000 --- a/t/op/concat.t +++ /dev/null @@ -1,161 +0,0 @@ -#!./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..30\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'); -} - -{ - # [perl #24508] optree construction bug - sub strfoo { "x" } - my ($x, $y); - $y = ($x = '' . strfoo()) . "y"; - ok( "$x,$y" eq "x,xy", 'figures out correct target' ); -} - -{ - # [perl #26905] "use bytes" doesn't apply byte semantics to concatenation - - my $p = "\xB6"; # PILCROW SIGN (ASCII/EBCDIC), 2bytes in UTF-X - my $u = "\x{100}"; - my $b = pack 'a*', "\x{100}"; - my $pu = "\xB6\x{100}"; - my $up = "\x{100}\xB6"; - my $x1 = $p; - my $y1 = $u; - - use bytes; - ok(beq($p.$u, $p.$b), "perl #26905, left eq bytes"); - ok(beq($u.$p, $b.$p), "perl #26905, right eq bytes"); - ok(!beq($p.$u, $pu), "perl #26905, left ne unicode"); - ok(!beq($u.$p, $up), "perl #26905, right ne unicode"); - - $x1 .= $u; - $x2 = $p . $u; - $y1 .= $p; - $y2 = $u . $p; - - no bytes; - ok(beq($x1, $x2), "perl #26905, left, .= vs = . in bytes"); - ok(beq($y1, $y2), "perl #26905, right, .= vs = . in bytes"); - ok(($x1 eq $x2), "perl #26905, left, .= vs = . in chars"); - ok(($y1 eq $y2), "perl #26905, right, .= vs = . in chars"); -} - -{ - # Concatenation needs to preserve UTF8ness of left oper. - my $x = eval"qr/\x{fff}/"; - ok( ord chop($x .= "\303\277") == 191, "UTF8ness preserved" ); -} - -{ - my $x; - $x = "a" . "b"; - $x .= "-append-"; - ok($x eq "ab-append-", "Appending to something initialized using constant folding"); -} |