Integrate mainline

p4raw-id: //depot/perlio@13108

4 files changed, 102 insertions, 20 deletions

diff --git a/t/op/closure.t b/t/op/closure.t
index 159392c93b..09df7c1134 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -4,6 +4,7 @@
 #   Original written by Ulrich Pfeifer on 2 Jan 1997.
 #   Greatly extended by Tom Phoenix <rootbeer@teleport.com> on 28 Jan 1997.
 #
+#   Run with -debug for debugging output.
 
 BEGIN {
     chdir 't' if -d 't';
@@ -16,7 +17,9 @@ print "1..171\n";
 
 my $test = 1;
 sub test (&) {
-  print ((&{$_[0]})?"ok $test\n":"not ok $test\n");
+  my $ok = &{$_[0]};
+  print $ok ? "ok $test\n" : "not ok $test\n";
+  printf "# Failed at line %d\n", (caller)[2] unless $ok;
   $test++;
 }
 
@@ -234,14 +237,14 @@ test {
 
 	  $code = "# This is a test script built by t/op/closure.t\n\n";
 
-	  $code .= <<"DEBUG_INFO" if $debugging;
-# inner_type: $inner_type 
+	  print <<"DEBUG_INFO" if $debugging;
+# inner_type:     $inner_type 
 # where_declared: $where_declared 
-# within: $within
-# nc_attempt: $nc_attempt
-# call_inner: $call_inner
-# call_outer: $call_outer
-# undef_outer: $undef_outer
+# within:         $within
+# nc_attempt:     $nc_attempt
+# call_inner:     $call_inner
+# call_outer:     $call_outer
+# undef_outer:    $undef_outer
 DEBUG_INFO
 
 	  $code .= <<"END_MARK_ONE";
@@ -262,9 +265,9 @@ END_MARK_TWO
 {
     my \$test = $test;
     sub test (&) {
-      my \$result = &{\$_[0]};
-      print "not " unless \$result;
-      print "ok \$test\\n";
+      my \$ok = &{\$_[0]};
+      print \$ok ? "ok \$test\n" : "not ok \$test\n";
+      printf "# Failed at line %d\n", (caller)[2] unless \$ok;
       \$test++;
     }
 }
@@ -499,7 +502,7 @@ END
 	    }
 	  }
 	  printf "not ok: exited with error code %04X\n", $? if $?;
-	  print "-" x 30, "\n" if $debugging;
+	  print '#', "-" x 30, "\n" if $debugging;
 
 	}	# End of foreach $within
       }	# End of foreach $where_declared
diff --git a/t/op/or.t b/t/op/or.t
new file mode 100644
index 0000000000..1f40d61ed5
--- /dev/null
+++ b/t/op/or.t
@@ -0,0 +1,68 @@
+#!./perl
+
+# Test || in weird situations.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+
+package Countdown;
+
+sub TIESCALAR {
+  my $class = shift;
+  my $instance = shift || undef;
+  return bless \$instance => $class;
+}
+
+sub FETCH {
+  print "# FETCH!  ${$_[0]}\n";
+  return ${$_[0]}--;
+}
+
+
+package main;
+require './test.pl';
+
+plan( tests => 8 );
+
+
+my ($a, $b, $c);
+
+$! = 1;
+$a = $!;
+my $a_str = sprintf "%s", $a;
+my $a_num = sprintf "%d", $a;
+
+$c = $a || $b;
+
+is($c, $a_str);
+is($c+0, $a_num);   # force numeric context.
+
+$a =~ /./g or die "Match failed for some reason"; # Make $a magic
+
+$c = $a || $b;
+
+is($c, $a_str);
+is($c+0, $a_num);   # force numeric context.
+
+my $val = 3;
+
+$c = $val || $b;
+is($c, 3);
+
+tie $a, 'Countdown', $val;
+
+$c = $a;
+is($c, 3,       'Single FETCH on tied scalar');
+
+$c = $a;
+is($c, 2,       '   $tied = $var');
+
+$c = $a || $b;
+
+{
+    local $TODO = 'Double FETCH';
+    is($c, 1,   '   $tied || $var');
+}
diff --git a/t/op/re_tests b/t/op/re_tests
index c7ab5ad814..1e80f5031c 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -537,7 +537,7 @@ 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	n	-	-
+'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
@@ -555,7 +555,7 @@ 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	n	-	-
+'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
@@ -609,7 +609,7 @@ 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	n	-	-
+'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
@@ -663,7 +663,7 @@ 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	n	-	-
+'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
diff --git a/t/op/repeat.t b/t/op/repeat.t
index ef462cb76e..82fcf75bd2 100755
--- a/t/op/repeat.t
+++ b/t/op/repeat.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan(tests => 24);
+plan(tests => 25);
 
 # compile time
 
@@ -118,7 +118,18 @@ is(77, scalar ((1,7)x2),    'stack truncation');
 
 # perlbug 20011113.110 works in 5.6.1, broken in 5.7.2
 {
-    local $TODO = 'list repeat in anon array ref broken [ID 20011113.110]';
-    my $x= [("foo") x 1];
-    is( join('', @$x), 'foofoo' );
+    my $x= [("foo") x 2];
+    is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' );
 }
+
+# [ID 20010809.028] x operator not copying elements in 'for' list?
+{
+    local $TODO = "x operator not copying elements in 'for' list? [ID 20010809.028]";
+    my $x = 'abcd';
+    my $y = '';
+    for (($x =~ /./g) x 2) {
+	$y .= chop;
+    }
+    is($y, 'abcdabcd');
+}
+