Added tests for multicharacter record delimiters

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

diff --git a/t/op/pat.t b/t/op/pat.t
old mode 100644 (file)
new mode 100755 (executable)
index c770391..d93e6d6
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: pat.t,v 4.0 91/03/20 01:54:01 lwall Locked $
+# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $
 
-print "1..43\n";
+print "1..60\n";
 
 $x = "abc\ndef\n";
 
@@ -73,7 +73,7 @@ while ($_ = shift(XXX)) {
     /not ok 26/ && reset 'X';
 }
 
-while (($key,$val) = each(XXX)) {
+while (($key,$val) = each(%XXX)) {
     print "not ok 27\n";
     exit;
 }
@@ -118,3 +118,89 @@ print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
 print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
 print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
 print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
+
+$_ = "now is the time for all good men to come to.";
+@words = /(\w+)/g;
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 44\n"
+    : "not ok 44\n";
+
+@words = ();
+while (/\w+/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 45\n"
+    : "not ok 45\n";
+
+@words = ();
+while (/to/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "to:to"
+    ? "ok 46\n"
+    : "not ok 46 @words\n";
+
+@words = /to/g;
+print join(':',@words) eq "to:to"
+    ? "ok 47\n"
+    : "not ok 47 @words\n";
+
+$_ = "abcdefghi";
+
+$pat1 = 'def';
+$pat2 = '^def';
+$pat3 = '.def.';
+$pat4 = 'abc';
+$pat5 = '^abc';
+$pat6 = 'abc$';
+$pat7 = 'ghi';
+$pat8 = '\w*ghi';
+$pat9 = 'ghi$';
+
+$t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
+
+for $iter (1..5) {
+    $t1++ if /$pat1/o;
+    $t2++ if /$pat2/o;
+    $t3++ if /$pat3/o;
+    $t4++ if /$pat4/o;
+    $t5++ if /$pat5/o;
+    $t6++ if /$pat6/o;
+    $t7++ if /$pat7/o;
+    $t8++ if /$pat8/o;
+    $t9++ if /$pat9/o;
+}
+
+$x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
+print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
+
+$xyz = 'xyz';
+print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
+
+# perl 4.009 says "unmatched ()"
+eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
+print $@ eq "" ? "ok 50\n" : "not ok 50\n";
+print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
+
+
+$_="abcfooabcbar";
+$x=/abc/g;
+print $` eq "" ? "ok 52\n" : "not ok 52\n" if $x;
+$x=/abc/g;
+print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x;
+$x=/abc/g;
+print $x == 0 ? "ok 54\n" : "not ok 54\n";
+$x=/ABC/gi;
+print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x;
+$x=/ABC/gi;
+print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x;
+$x=/ABC/gi;
+print $x == 0 ? "ok 57\n" : "not ok 57\n";
+$x=/abc/g;
+print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x;
+$x=/abc/g;
+print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x;
+$_ .= '';
+@x=/abc/g;
+print scalar @x == 2 ? "ok 60\n" : "not ok 60\n";