X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fregexp.t;h=b4288b2e668dbcf30310abf1ce8d530a1f03551c;hb=3ab3c9b49fb213f2b1d4cda8797de17be82b2b15;hp=239fa84f7782334f54cf17b8e5e822464d2d1fa8;hpb=ee595aa61f33e2c496a8bb874b2aa10ecd77c6cc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/regexp.t b/t/op/regexp.t index 239fa84..b4288b2 100755 --- a/t/op/regexp.t +++ b/t/op/regexp.t @@ -1,8 +1,5 @@ #!./perl -# XXX known to leak scalars -$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; - # The tests are in a separate file 't/op/re_tests'. # Each line in that file is a separate test. # There are five columns, separated by tabs. @@ -41,7 +38,7 @@ BEGIN { $iters = shift || 1; # Poor man performance suite, 10000 is OK. -open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || +open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || open(TESTS,':op:re_tests') || die "Can't open re_tests"; while () { } @@ -52,6 +49,7 @@ $. = 0; $bang = sprintf "\\%03o", ord "!"; # \41 would not be portable. $ffff = chr(0xff) x 2; $nulnul = "\0" x 2; +$OP = $qr ? 'qr' : 'm'; $| = 1; print "1..$numtests\n# $iters iterations\n"; @@ -72,13 +70,11 @@ while () { $expect =~ s/\\n/\n/g; $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/; $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//)); - # Certain tests don't work with utf8 (the re_test should be in UTF8) - $skip = 1, $reason = 'utf8' - if ($^H &= ~0x00000008) && $pat =~ /\[:\^(alnum|print|word):\]/; + $reason = 'skipping $&' if $reason eq '' && $skip_amp; $result =~ s/B//i unless $skip; for $study ('', 'study \$subject') { $c = $iters; - eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";"; + eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";"; chomp( $err = $@ ); if ($result eq 'c') { if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }