Integrate from mainperl.

p4raw-id: //depot/cfgperl@3478

6 files changed, 277 insertions, 13 deletions

diff --git a/t/comp/proto.t b/t/comp/proto.t
index 956b9846f2..3474a7e1ba 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 
-print "1..87\n";
+print "1..100\n";
 
 my $i = 1;
 
@@ -417,9 +417,41 @@ print "ok ", $i++, "\n";
 # test if the (*) prototype allows barewords, constants, scalar expressions,
 # globs and globrefs (just as CORE::open() does), all under stricture
 sub star (*&) { &{$_[1]} }
+sub star2 (**&) { &{$_[2]} }
+sub BAR { "quux" }
 my $star = 'FOO';
 star FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star(FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++;
 star "FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star("FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++;
 star $star, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+star($star, sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++;
 star *FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
+star(*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }); $i++;
 star \*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
+star(\*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }); $i++;
+star2 FOO, BAR, sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'BAR' }; $i++;
+star2(BAR, FOO, sub { print "ok $i\n"
+			if $_[0] eq 'BAR' and $_[1] eq 'FOO' }); $i++;
+star2 BAR(), FOO, sub { print "ok $i\n"
+			if $_[0] eq 'quux' and $_[1] eq 'FOO' }; $i++;
+star2(FOO, BAR(), sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'quux' }); $i++;
+star2 "FOO", "BAR", sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'BAR' }; $i++;
+star2("FOO", "BAR", sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'BAR' }); $i++;
+star2 $star, $star, sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'FOO' }; $i++;
+star2($star, $star, sub { print "ok $i\n"
+			if $_[0] eq 'FOO' and $_[1] eq 'FOO' }); $i++;
+star2 *FOO, *BAR, sub { print "ok $i\n"
+			if $_[0] eq \*FOO and $_[0] eq \*BAR }; $i++;
+star2(*FOO, *BAR, sub { print "ok $i\n"
+			if $_[0] eq \*FOO and $_[0] eq \*BAR }); $i++;
+star2 \*FOO, \*BAR, sub { no strict 'refs'; print "ok $i\n"
+			if $_[0] eq \*{'FOO'} and $_[0] eq \*{'BAR'} }; $i++;
+star2(\*FOO, \*BAR, sub { no strict 'refs'; print "ok $i\n"
+			if $_[0] eq \*{'FOO'} and $_[0] eq \*{'BAR'} }); $i++;
+
diff --git a/t/lib/bigintpm.t b/t/lib/bigintpm.t
index f2e9d512ad..ae362e20c9 100755
--- a/t/lib/bigintpm.t
+++ b/t/lib/bigintpm.t
@@ -9,7 +9,7 @@ use Math::BigInt;
 
 $test = 0;
 $| = 1;
-print "1..276\n";
+print "1..278\n";
 while (<DATA>) {
        chop;
        if (s/^&//) {
@@ -64,7 +64,24 @@ while (<DATA>) {
                        print "# '$try' expected: '$ans' got: '$ans1'\n";
                }
        }
-} 
+}
+
+{
+  use Math::BigInt ':constant';
+
+  $test++;
+  print "not " 
+    unless 2**150 eq "+1427247692705959881058285969449495136382746624";
+  print "ok $test\n";
+  $test++;
+  @a = ();
+  for ($i = 1; $i < 10; $i++) {
+    push @a, $i;
+  }
+  print "not " unless "@a" eq "+1 +2 +3 +4 +5 +6 +7 +8 +9";
+  print "ok $test\n";
+}
+ 
 __END__
 &bnorm
 abc:NaN
diff --git a/t/lib/fatal.t b/t/lib/fatal.t
index fb3757f5cd..019265899a 100755
--- a/t/lib/fatal.t
+++ b/t/lib/fatal.t
@@ -3,11 +3,11 @@
 BEGIN {
    chdir 't' if -d 't';
    unshift @INC, '../lib';
-   print "1..9\n";
+   print "1..13\n";
 }
 
 use strict;
-use Fatal qw(open);
+use Fatal qw(open close);
 
 my $i = 1;
 eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
@@ -20,8 +20,9 @@ for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
     print "not " if $@;
     print "ok $i\n"; ++$i;
 
-    print "not " unless scalar(<FOO>) =~ m|^#!./perl|;
+    print "not " if $@ or scalar(<$foo>) !~ m|^#!./perl|;
+    print "ok $i\n"; ++$i;
+    eval qq{ close FOO };
     print "not " if $@;
     print "ok $i\n"; ++$i;
-    close FOO;
 }
diff --git a/t/op/pat.t b/t/op/pat.t
index b6a3a3a240..a086c12eaf 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
 # 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..186\n";
+print "1..188\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -858,3 +858,17 @@ $test++;
 print "$1\n";
 $test++;
 
+# See if $i work inside (?{}) in the presense of saved substrings and
+# changing $_
+@a = qw(foo bar);
+@b = ();
+s/(\w)(?{push @b, $1})/,$1,/g for @a;
+
+print "# \@b='@b', expect 'f o o b a r'\nnot " unless("@b" eq "f o o b a r");
+print "ok $test\n";
+$test++;
+
+print "not " unless("@a" eq ",f,,o,,o, ,b,,a,,r,");
+print "ok $test\n";
+$test++;
+
diff --git a/t/op/re_tests b/t/op/re_tests
index ba824aeefa..466fc856c9 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -482,11 +482,204 @@ $(?<=^(a))	a	y	$1	a
 ((?>[^()]+)|\([^()]*\))+	((abc(ade)ufh()()x	y	$&	abc(ade)ufh()()x
 (?<=x+)y	-	c	-	/(?<=x+)y/: variable length lookbehind not implemented
 a{37,17}	-	c	-	/a{37,17}/: Can't do {n,m} with n > m
+\Z	a\nb\n	y	$-[0]	3
+\z	a\nb\n	y	$-[0]	4
+$	a\nb\n	y	$-[0]	3
+\Z	b\na\n	y	$-[0]	3
+\z	b\na\n	y	$-[0]	4
+$	b\na\n	y	$-[0]	3
+\Z	b\na	y	$-[0]	3
+\z	b\na	y	$-[0]	3
+$	b\na	y	$-[0]	3
+'\Z'm	a\nb\n	y	$-[0]	3
+'\z'm	a\nb\n	y	$-[0]	4
+'$'m	a\nb\n	y	$-[0]	1
+'\Z'm	b\na\n	y	$-[0]	3
+'\z'm	b\na\n	y	$-[0]	4
+'$'m	b\na\n	y	$-[0]	1
+'\Z'm	b\na	y	$-[0]	3
+'\z'm	b\na	y	$-[0]	3
+'$'m	b\na	y	$-[0]	1
 a\Z	a\nb\n	n	-	-
-b\Z	a\nb\n	y	-	-
-b\z	a\nb\n	n	-	-
-b\Z	a\nb	y	-	-
-b\z	a\nb	y	-	-
+a\z	a\nb\n	n	-	-
+a$	a\nb\n	n	-	-
+a\Z	b\na\n	y	$-[0]	2
+a\z	b\na\n	n	-	-
+a$	b\na\n	y	$-[0]	2
+a\Z	b\na	y	$-[0]	2
+a\z	b\na	y	$-[0]	2
+a$	b\na	y	$-[0]	2
+'a\Z'm	a\nb\n	bn	-	-
+'a\z'm	a\nb\n	n	-	-
+'a$'m	a\nb\n	y	$-[0]	0
+'a\Z'm	b\na\n	y	$-[0]	2
+'a\z'm	b\na\n	n	-	-
+'a$'m	b\na\n	y	$-[0]	2
+'a\Z'm	b\na	y	$-[0]	2
+'a\z'm	b\na	y	$-[0]	2
+'a$'m	b\na	y	$-[0]	2
+aa\Z	aa\nb\n	n	-	-
+aa\z	aa\nb\n	n	-	-
+aa$	aa\nb\n	n	-	-
+aa\Z	b\naa\n	y	$-[0]	2
+aa\z	b\naa\n	n	-	-
+aa$	b\naa\n	y	$-[0]	2
+aa\Z	b\naa	y	$-[0]	2
+aa\z	b\naa	y	$-[0]	2
+aa$	b\naa	y	$-[0]	2
+'aa\Z'm	aa\nb\n	bn	-	-
+'aa\z'm	aa\nb\n	n	-	-
+'aa$'m	aa\nb\n	y	$-[0]	0
+'aa\Z'm	b\naa\n	y	$-[0]	2
+'aa\z'm	b\naa\n	n	-	-
+'aa$'m	b\naa\n	y	$-[0]	2
+'aa\Z'm	b\naa	y	$-[0]	2
+'aa\z'm	b\naa	y	$-[0]	2
+'aa$'m	b\naa	y	$-[0]	2
+aa\Z	ac\nb\n	n	-	-
+aa\z	ac\nb\n	n	-	-
+aa$	ac\nb\n	n	-	-
+aa\Z	b\nac\n	n	-	-
+aa\z	b\nac\n	n	-	-
+aa$	b\nac\n	n	-	-
+aa\Z	b\nac	n	-	-
+aa\z	b\nac	n	-	-
+aa$	b\nac	n	-	-
+'aa\Z'm	ac\nb\n	n	-	-
+'aa\z'm	ac\nb\n	n	-	-
+'aa$'m	ac\nb\n	n	-	-
+'aa\Z'm	b\nac\n	n	-	-
+'aa\z'm	b\nac\n	n	-	-
+'aa$'m	b\nac\n	n	-	-
+'aa\Z'm	b\nac	n	-	-
+'aa\z'm	b\nac	n	-	-
+'aa$'m	b\nac	n	-	-
+aa\Z	ca\nb\n	n	-	-
+aa\z	ca\nb\n	n	-	-
+aa$	ca\nb\n	n	-	-
+aa\Z	b\nca\n	n	-	-
+aa\z	b\nca\n	n	-	-
+aa$	b\nca\n	n	-	-
+aa\Z	b\nca	n	-	-
+aa\z	b\nca	n	-	-
+aa$	b\nca	n	-	-
+'aa\Z'm	ca\nb\n	n	-	-
+'aa\z'm	ca\nb\n	n	-	-
+'aa$'m	ca\nb\n	n	-	-
+'aa\Z'm	b\nca\n	n	-	-
+'aa\z'm	b\nca\n	n	-	-
+'aa$'m	b\nca\n	n	-	-
+'aa\Z'm	b\nca	n	-	-
+'aa\z'm	b\nca	n	-	-
+'aa$'m	b\nca	n	-	-
+ab\Z	ab\nb\n	n	-	-
+ab\z	ab\nb\n	n	-	-
+ab$	ab\nb\n	n	-	-
+ab\Z	b\nab\n	y	$-[0]	2
+ab\z	b\nab\n	n	-	-
+ab$	b\nab\n	y	$-[0]	2
+ab\Z	b\nab	y	$-[0]	2
+ab\z	b\nab	y	$-[0]	2
+ab$	b\nab	y	$-[0]	2
+'ab\Z'm	ab\nb\n	bn	-	-
+'ab\z'm	ab\nb\n	n	-	-
+'ab$'m	ab\nb\n	y	$-[0]	0
+'ab\Z'm	b\nab\n	y	$-[0]	2
+'ab\z'm	b\nab\n	n	-	-
+'ab$'m	b\nab\n	y	$-[0]	2
+'ab\Z'm	b\nab	y	$-[0]	2
+'ab\z'm	b\nab	y	$-[0]	2
+'ab$'m	b\nab	y	$-[0]	2
+ab\Z	ac\nb\n	n	-	-
+ab\z	ac\nb\n	n	-	-
+ab$	ac\nb\n	n	-	-
+ab\Z	b\nac\n	n	-	-
+ab\z	b\nac\n	n	-	-
+ab$	b\nac\n	n	-	-
+ab\Z	b\nac	n	-	-
+ab\z	b\nac	n	-	-
+ab$	b\nac	n	-	-
+'ab\Z'm	ac\nb\n	n	-	-
+'ab\z'm	ac\nb\n	n	-	-
+'ab$'m	ac\nb\n	n	-	-
+'ab\Z'm	b\nac\n	n	-	-
+'ab\z'm	b\nac\n	n	-	-
+'ab$'m	b\nac\n	n	-	-
+'ab\Z'm	b\nac	n	-	-
+'ab\z'm	b\nac	n	-	-
+'ab$'m	b\nac	n	-	-
+ab\Z	ca\nb\n	n	-	-
+ab\z	ca\nb\n	n	-	-
+ab$	ca\nb\n	n	-	-
+ab\Z	b\nca\n	n	-	-
+ab\z	b\nca\n	n	-	-
+ab$	b\nca\n	n	-	-
+ab\Z	b\nca	n	-	-
+ab\z	b\nca	n	-	-
+ab$	b\nca	n	-	-
+'ab\Z'm	ca\nb\n	n	-	-
+'ab\z'm	ca\nb\n	n	-	-
+'ab$'m	ca\nb\n	n	-	-
+'ab\Z'm	b\nca\n	n	-	-
+'ab\z'm	b\nca\n	n	-	-
+'ab$'m	b\nca\n	n	-	-
+'ab\Z'm	b\nca	n	-	-
+'ab\z'm	b\nca	n	-	-
+'ab$'m	b\nca	n	-	-
+abb\Z	abb\nb\n	n	-	-
+abb\z	abb\nb\n	n	-	-
+abb$	abb\nb\n	n	-	-
+abb\Z	b\nabb\n	y	$-[0]	2
+abb\z	b\nabb\n	n	-	-
+abb$	b\nabb\n	y	$-[0]	2
+abb\Z	b\nabb	y	$-[0]	2
+abb\z	b\nabb	y	$-[0]	2
+abb$	b\nabb	y	$-[0]	2
+'abb\Z'm	abb\nb\n	bn	-	-
+'abb\z'm	abb\nb\n	n	-	-
+'abb$'m	abb\nb\n	y	$-[0]	0
+'abb\Z'm	b\nabb\n	y	$-[0]	2
+'abb\z'm	b\nabb\n	n	-	-
+'abb$'m	b\nabb\n	y	$-[0]	2
+'abb\Z'm	b\nabb	y	$-[0]	2
+'abb\z'm	b\nabb	y	$-[0]	2
+'abb$'m	b\nabb	y	$-[0]	2
+abb\Z	ac\nb\n	n	-	-
+abb\z	ac\nb\n	n	-	-
+abb$	ac\nb\n	n	-	-
+abb\Z	b\nac\n	n	-	-
+abb\z	b\nac\n	n	-	-
+abb$	b\nac\n	n	-	-
+abb\Z	b\nac	n	-	-
+abb\z	b\nac	n	-	-
+abb$	b\nac	n	-	-
+'abb\Z'm	ac\nb\n	n	-	-
+'abb\z'm	ac\nb\n	n	-	-
+'abb$'m	ac\nb\n	n	-	-
+'abb\Z'm	b\nac\n	n	-	-
+'abb\z'm	b\nac\n	n	-	-
+'abb$'m	b\nac\n	n	-	-
+'abb\Z'm	b\nac	n	-	-
+'abb\z'm	b\nac	n	-	-
+'abb$'m	b\nac	n	-	-
+abb\Z	ca\nb\n	n	-	-
+abb\z	ca\nb\n	n	-	-
+abb$	ca\nb\n	n	-	-
+abb\Z	b\nca\n	n	-	-
+abb\z	b\nca\n	n	-	-
+abb$	b\nca\n	n	-	-
+abb\Z	b\nca	n	-	-
+abb\z	b\nca	n	-	-
+abb$	b\nca	n	-	-
+'abb\Z'm	ca\nb\n	n	-	-
+'abb\z'm	ca\nb\n	n	-	-
+'abb$'m	ca\nb\n	n	-	-
+'abb\Z'm	b\nca\n	n	-	-
+'abb\z'm	b\nca\n	n	-	-
+'abb$'m	b\nca\n	n	-	-
+'abb\Z'm	b\nca	n	-	-
+'abb\z'm	b\nca	n	-	-
+'abb$'m	b\nca	n	-	-
 (^|x)(c)	ca	y	$2	c
 a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz	x	n	-	-
 a(?{$a=2;$b=3;($b)=$a})b	yabz	y	$b	2
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 98d998d9e5..66b2d1c116 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -16,6 +16,8 @@ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 # 	y	expect a match
 # 	n	expect no match
 # 	c	expect an error
+#	B	test exposes a known bug in Perl, should be skipped
+#	b	test exposes a known bug in Perl, should be skipped if noamp
 #
 # Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
 #
@@ -62,7 +64,9 @@ while (<TESTS>) {
     $subject =~ s/\\n/\n/g;
     $expect =~ s/\\n/\n/g;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
-    for $study ("", "study \$subject") {
+    $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
+    $result =~ s/B//i unless $skip;
+    for $study ('', 'study \$subject') {
  	$c = $iters;
  	eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
 	chomp( $err = $@ );
@@ -70,6 +74,9 @@ while (<TESTS>) {
 	    if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
 	    last;  # no need to study a syntax error
 	}
+	elsif ( $skip ) {
+	    print "ok $. # Skipped: not fixed yet\n"; next TEST;
+	}
 	elsif ($@) {
 	    print "not ok $. $input => error `$err'\n"; next TEST;
 	}