chdir 't' if -d 't';
@INC = '../lib';
}
+our $Message = "Noname test";
eval 'use Config'; # Defaults assumed if this fails
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;
@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 ";
sub ok ($;$) {
my($ok, $name) = @_;
- printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed';
+ printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ ($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
my $ok= $got eq $expect;
- printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed';
+ printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ ($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
"# expected: %s\n".
}
{
# Test named commits and the $REGERROR var
+ local $Message = "\$REGERROR";
our $REGERROR;
for $word (qw(bar baz bop)) {
$REGERROR="";
}
}
{ #Regression test for perlbug 40684
+ local $Message = "RT#40684 tests:";
my $s = "abc\ndef";
my $rex = qr'^abc$'m;
ok($s =~ m/$rex/);
}
{
+ local $Message = "Relative Recursion";
my $parens=qr/(\((?:[^()]++|(?-1))*+\))/;
local $_='foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
my ($all,$one,$two)=('','','');
iseq($_,$spaces,"SUSPEND final string");
iseq($count,1,"Optimiser should have prevented more than one match");
}
+{
+ local $Message = "RT#36909 test";
+ $^R = 'Nothing';
+ {
+ local $^R = "Bad";
+ ok('x foofoo y' =~ m{
+ (foo) # $^R correctly set
+ (?{ "last regexp code result" })
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ iseq($^R,'Nothing');
+ {
+ local $^R = "Bad";
+ ok('x foofoo y' =~ m{
+ (?:foo|bar)+ # $^R correctly set
+ (?{"last regexp code result"})
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ iseq($^R,'Nothing');
+
+ {
+ local $^R = "Bad";
+ ok('x foofoo y' =~ m{
+ (foo|bar)\1+ # $^R undefined
+ (?{"last regexp code result"})
+ }x);
+ iseq($^R,'last regexp code result');
+ }
+ 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')
+}
+
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
# Keep the following tests last -- they may crash perl
or print "# Unexpected outcome: should pass or crash perl\n";
{
+ local $Message = "substitution with lookahead (possible segv)";
$_="ns1ns1ns1";
s/ns(?=\d)/ns_/g;
iseq($_,"ns_1ns_1ns_1");
}
# 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..1349\n" };
+BEGIN {
+ $::TestCount = 1369;
+ print "1..$::TestCount\n";
+}
+