Test hex('x...').

[p5sagit/p5-mst-13.2.git] / t / op / split.t

diff --git a/t/op/split.t b/t/op/split.t
index 90bb436..7f0acce 100755 (executable)
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
 
-print "1..14\n";
+print "1..25\n";
 
 $FS = ':';
 
@@ -66,3 +66,48 @@ print $_ eq "1|-|10||20" ? "ok 13\n" : "not ok 13\n";
 # do subpatterns generate additional fields (with a limit)?
 $_ = join '|', split(/,|(-)/, "1-10,20,,,", 10);
 print $_ eq "1|-|10||20||||||" ? "ok 14\n" : "not ok 14\n";
+
+# is the 'two undefs' bug fixed?
+(undef, $a, undef, $b) = qw(1 2 3 4);
+print "$a|$b" eq "2|4" ? "ok 15\n" : "not ok 15\n";
+
+# .. even for locals?
+{
+  local(undef, $a, undef, $b) = qw(1 2 3 4);
+  print "$a|$b" eq "2|4" ? "ok 16\n" : "not ok 16\n";
+}
+
+# check splitting of null string
+$_ = join('|', split(/x/,   '',-1), 'Z');
+print $_ eq "Z" ? "ok 17\n" : "#$_\nnot ok 17\n";
+
+$_ = join('|', split(/x/,   '', 1), 'Z');
+print $_ eq "Z" ? "ok 18\n" : "#$_\nnot ok 18\n";
+
+$_ = join('|', split(/(p+)/,'',-1), 'Z');
+print $_ eq "Z" ? "ok 19\n" : "#$_\nnot ok 19\n";
+
+$_ = join('|', split(/.?/,  '',-1), 'Z');
+print $_ eq "Z" ? "ok 20\n" : "#$_\nnot ok 20\n";
+
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^a/m, "a b a\na d a", 20);
+print $_ eq "| b a\n| d a" ? "ok 21\n" : "not ok 21\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/a$/m, "a b a\na d a", 20);
+print $_ eq "a b |\na d |" ? "ok 22\n" : "not ok 22\n# `$_'\n";
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^aa/m, "aa b aa\naa d aa", 20);
+print $_ eq "| b aa\n| d aa" ? "ok 23\n" : "not ok 23\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/aa$/m, "aa b aa\naa d aa", 20);
+print $_ eq "aa b |\naa d |" ? "ok 24\n" : "not ok 24\n# `$_'\n";
+
+# Greedyness:
+$_ = "a : b :c: d";
+@ary = split(/\s*:\s*/);
+if (($res = join(".",@ary)) eq "a.b.c.d") {print "ok 25\n";} else {print "not ok 25\n# res=`$res' != `a.b.c.d'\n";}