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 68328f8..31922e9 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -12,7 +12,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
-our $Message = "Line";
+our $Message = "Noname test";
 
 eval 'use Config';          #  Defaults assumed if this fails
 
@@ -875,9 +875,7 @@ $foo='aabbccddeeffgg';
 pos($foo)=1;
 
 $foo=~/.\G(..)/g;
-print "not " unless($1 eq 'ab');
-print "ok $test\n";
-$test++;
+iseq($1,'ab');
 
 pos($foo) += 1;
 $foo=~/.\G(..)/g;
@@ -1048,9 +1046,7 @@ $test++;
 
 @b = grep(/\w/,@a);
 @c = grep(/[\w]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
+iseq("@b","@c");
 
 # see if backtracking optimization works correctly
 "\n\n" =~ /\n  $ \n/x or print "not ";
@@ -2039,7 +2035,7 @@ sub ok ($;$) {
     my($ok, $name) = @_;
 
     printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
-        $name||"$Message:".((caller)[2]);
+        ($name||$Message)."\tLine ".((caller)[2]);
 
     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
 
@@ -3676,7 +3672,7 @@ sub iseq($$;$) {
     my $ok=  $got eq $expect;
         
     printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
-        $name||"$Message:".((caller)[2]);
+        ($name||$Message)."\tLine ".((caller)[2]);
 
     printf "# Failed test at line %d\n".
            "# expected: %s\n". 
@@ -4054,7 +4050,120 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) {
     }
     iseq($^R,'Nothing');
 }
+{
+    local $Message="RT#22395";
+    our $count;
+    for my $l (10,100,1000) {
+       $count=0;
+       ('a' x $l) =~ /(.*)(?{$count++})[bc]/;
+       iseq( $count, $l + 1, "# TODO Should be L+1 not L*(L+3)/2 (L=$l)");
+    }
+}
+{
+    local $Message = "RT#22614";
+    local $_='ab';
+    our @len=();
+    /(.){1,}(?{push @len,0+@-})(.){1,}(?{})^/;
+    iseq("@len","2 2 2");
+}
+{
+    local $Message = "RT#18209";
+    my $text = ' word1 word2 word3 word4 word5 word6 ';
+
+    my @words = ('word1', 'word3', 'word5');
+    my $count;
+    foreach my $word (@words){
+        $text =~ s/$word\s//gi; # Leave a space to seperate words in the resultant str.
+        # The following block is not working.
+        if($&){
+            $count++;
+        }
+        # End bad block
+    }
+    iseq($count,3);
+    iseq($text,' word2 word4 word6 ');
+}
+{
+    # RT#6893
+    local $_= qq(A\nB\nC\n); 
+    my @res;
+    while (m#(\G|\n)([^\n]*)\n#gsx) 
+    { 
+        push @res,"$2"; 
+        last if @res>3;
+    }
+    iseq("@res","A B C","RT#6893: /g pattern shouldn't infinite loop");
+}
 
+{
+    # From Message-ID: <877ixs6oa6.fsf@k75.linux.bogus>
+    my $dow_name= "nada";
+    my $parser = "(\$dow_name) = \$time_string =~ /(D\x{e9}\\ C\x{e9}adaoin|D\x{e9}\\ Sathairn|\\w+|\x{100})/";
+    my $time_string = "D\x{e9} C\x{e9}adaoin";
+    eval $parser;
+    ok(!$@,"Test Eval worked");
+    iseq($dow_name,$time_string,"UTF8 trie common prefix extraction");
+}
+
+{
+    my $v;
+    ($v='bar')=~/(\w+)/g;
+    $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
@@ -4085,7 +4194,7 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/,
     or print "# Unexpected outcome: should pass or crash perl\n";
 
 {
-    local $Message = "substituation with lookahead (possible segv)";
+    local $Message = "substitution with lookahead (possible segv)";
     $_="ns1ns1ns1";
     s/ns(?=\d)/ns_/g;
     iseq($_,"ns_1ns_1ns_1");
@@ -4098,6 +4207,10 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/,
 }
 
 # Put new tests above the dotted line about a page above this comment
-
+iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
-BEGIN { print "1..1358\n" };
+BEGIN {
+    $::TestCount = 1573; 
+    print "1..$::TestCount\n";
+}
+