[patch: perl@8211]VMS: add -Duseperlio capacity to configure.com

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

diff --git a/t/op/pat.t b/t/op/pat.t
index 76a7ef3..aaec39d 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,11 +4,11 @@
 # 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..215\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
 
@@ -496,7 +496,7 @@ $test++;
 $_ = '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++;
 }
@@ -504,7 +504,7 @@ foreach $ans ('', 'c') {
 $_ = 'a';
 foreach $ans ('', 'a', '') {
   /^|a|$/g;
-  print "not " unless $& eq $ans;
+  print "# \$&  ='$&'\n# \$ans='$ans'\nnot " unless $& eq $ans;
   print "ok $test\n";
   $test++;
 }
@@ -545,6 +545,22 @@ $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 " 
@@ -554,6 +570,23 @@ $test++;
 }
 
 {
+  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;
@@ -693,6 +726,30 @@ print "not "
 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";
@@ -1025,3 +1082,43 @@ $test++;
 'a1b' =~ ('xyz' =~ /t/) and $` eq 'a' or print "not ";
 print "ok $test\n";
 $test++;
+
+$w = 0;
+{
+    local $SIG{__WARN__} = sub { $w = 1 };
+    local $^W = 1;
+       $w = 1 if ("1\n" x 102) =~ /^\s*\n/m;
+}
+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++;