# the format supported by op/regexp.t. If you want to add a test
# that does fit that format, add it to op/re_tests, not here.
-print "1..216\n";
+print "1..230\n";
BEGIN {
chdir 't' if -d 't';
- unshift @INC, "../lib" if -d "../lib";
+ @INC = '../lib';
}
eval 'use Config'; # Defaults assumed if this fails
$_ = 'xabcx';
foreach $ans ('', 'c') {
/(?<=(?=a)..)((?=c)|.)/g;
- print "not " unless $1 eq $ans;
+ print "# \$1 ='$1'\n# \$ans='$ans'\nnot " unless $1 eq $ans;
print "ok $test\n";
$test++;
}
$_ = 'a';
foreach $ans ('', 'a', '') {
/^|a|$/g;
- print "not " unless $& eq $ans;
+ print "# \$& ='$&'\n# \$ans='$ans'\nnot " unless $& eq $ans;
print "ok $test\n";
$test++;
}
print "ok $test\n";
$test++;
+ local $lex_a = 2;
+ my $lex_a = 43;
+ my $lex_b = 17;
+ my $lex_c = 27;
+ my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
+ print "not " unless $lex_res eq '1';
+ print "ok $test\n";
+ $test++;
+ print "not " unless $lex_a eq '44';
+ print "ok $test\n";
+ $test++;
+ print "not " unless $lex_c eq '43';
+ print "ok $test\n";
+ $test++;
+
+
no re "eval";
$match = eval { /$a$c$a/ };
print "not "
}
{
+ local $lex_a = 2;
+ my $lex_a = 43;
+ my $lex_b = 17;
+ my $lex_c = 27;
+ my $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
+ print "not " unless $lex_res eq '1';
+ print "ok $test\n";
+ $test++;
+ print "not " unless $lex_a eq '44';
+ print "ok $test\n";
+ $test++;
+ print "not " unless $lex_c eq '43';
+ print "ok $test\n";
+ $test++;
+}
+
+{
package aa;
$c = 2;
$::c = 3;
print "ok $test\n";
$test++;
+eval { $+[0] = 13; };
+print "not "
+ if $@ !~ /^Modification of a read-only value attempted/;
+print "ok $test\n";
+$test++;
+
+eval { $-[0] = 13; };
+print "not "
+ if $@ !~ /^Modification of a read-only value attempted/;
+print "ok $test\n";
+$test++;
+
+eval { @+ = (7, 6, 5); };
+print "not "
+ if $@ !~ /^Modification of a read-only value attempted/;
+print "ok $test\n";
+$test++;
+
+eval { @- = qw(foo bar); };
+print "not "
+ if $@ !~ /^Modification of a read-only value attempted/;
+print "ok $test\n";
+$test++;
+
/.(a)(ba*)?/;
print "#$#-..$#+\nnot " if $#+ != 2 or $#- != 1;
print "ok $test\n";
}
print $w ? "not " : "", "ok $test\n";
$test++;
+
+my %space = ( spc => " ",
+ tab => "\t",
+ cr => "\r",
+ lf => "\n",
+ ff => "\f",
+# There's no \v but the vertical tabulator seems miraculously
+# be 11 both in ASCII and EBCDIC.
+ vt => chr(11),
+ false => "space" );
+
+my @space0 = sort grep { $space{$_} =~ /\s/ } keys %space;
+my @space1 = sort grep { $space{$_} =~ /[[:space:]]/ } keys %space;
+my @space2 = sort grep { $space{$_} =~ /[[:blank:]]/ } keys %space;
+
+print "not " unless "@space0" eq "cr ff lf spc tab";
+print "ok $test # @space0\n";
+$test++;
+
+print "not " unless "@space1" eq "cr ff lf spc tab vt";
+print "ok $test # @space1\n";
+$test++;
+
+print "not " unless "@space2" eq "spc tab";
+print "ok $test # @space2\n";
+$test++;
+
+# bugid 20001021.005 - this caused a SEGV
+print "not " unless undef =~ /^([^\/]*)(.*)$/;
+print "ok $test\n";
+$test++;