summaryrefslogtreecommitdiff
path: root/t/op/concat.t
diff options
context:
space:
mode:
authorJames E Keenan <jkeenan@cpan.org>2012-12-02 08:11:13 -0500
committerJames E Keenan <jkeenan@cpan.org>2012-12-07 20:05:00 -0500
commit8a5eedb005f7c37f37bea546d40741b5a9ccfad2 (patch)
treee0622cd951f9cea9c1c8789b3f7d47452f2a079a /t/op/concat.t
parent2f445b24d1fcccfa186e5ac8cd8f82a820c4369d (diff)
downloadperl-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.t161
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");
-}