Fixes for the test suite on OS/2

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

diff --git a/t/op/pat.t b/t/op/pat.t
index f337a58..31922e9 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4111,7 +4111,59 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) {
     $v='foo';
     iseq("$1",'bar','$1 is safe after /g - may fail due to specialized config in pp_hot.c')
 }
- 
+{
+    local $Message = "http://nntp.perl.org/group/perl.perl5.porters/118663";
+    my $qr_barR1 = qr/(bar)\g-1/;
+    ok("foobarbarxyz" =~ $qr_barR1);
+    ok("foobarbarxyz" =~ qr/foo${qr_barR1}xyz/);
+    ok("foobarbarxyz" =~ qr/(foo)${qr_barR1}xyz/);
+    ok("foobarbarxyz" =~ qr/(foo)(bar)\g{-1}xyz/);
+    ok("foobarbarxyz" =~ qr/(foo${qr_barR1})xyz/);
+    ok("foobarbarxyz" =~ qr/(foo(bar)\g{-1})xyz/);
+} 
+{
+    local $Message = "RT#41010";
+    my @tails=('','(?(1))','(|)','()?');    
+    my @quants=('*','+');
+    my $doit=sub {
+        my $pats= shift;
+        for (@_) {
+            for my $pat (@$pats) {
+                for my $quant (@quants) {
+                    for my $tail (@tails) {
+                        my $re = "($pat$quant\$)$tail";
+                        ok(/$re/ && $1 eq $_,"'$_'=~/$re/");
+                        ok(/$re/m && $1 eq $_,"'$_'=~/$re/m");
+                    }
+                }
+            }
+       }
+    };    
+    
+    my @dpats=( 
+                '\d',
+                '[1234567890]',
+                '(1|[23]|4|[56]|[78]|[90])',
+                '(?:1|[23]|4|[56]|[78]|[90])',
+                '(1|2|3|4|5|6|7|8|9|0)',
+                '(?:1|2|3|4|5|6|7|8|9|0)',
+             );
+    my @spats=('[ ]',' ','( |\t)','(?: |\t)','[ \t]','\s');
+    my @sstrs=('  ');
+    my @dstrs=('12345');
+    $doit->(\@spats,@sstrs);
+    $doit->(\@dpats,@dstrs);
+}
+{
+    local $Message = "\$REGMARK";
+    our @r=();
+    ok('foofoo' =~ /foo (*MARK:foo) (?{push @r,$REGMARK}) /x);
+    iseq("@r","foo");           
+    iseq($REGMARK,"foo");
+    ok('foofoo' !~ /foo (*MARK:foo) (*FAIL) /x);
+    ok(!$REGMARK);
+    iseq($REGERROR,'foo');
+}
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4158,7 +4210,7 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/,
 iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
 BEGIN {
-    $::TestCount = 1369; 
+    $::TestCount = 1573; 
     print "1..$::TestCount\n";
 }