Re: [ID 20000807.008] Double reads considered evil? (deja vu)

Message-Id: <E13MAj1-00038W-00@libra.cus.cam.ac.uk>

p4raw-id: //depot/perl@6552

2 files changed, 36 insertions, 5 deletions

diff --git a/t/op/join.t b/t/op/join.t
index def5a9e9fa..b50878e735 100755
--- a/t/op/join.t
+++ b/t/op/join.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..6\n";
+print "1..10\n";
 
 @x = (1, 2, 3);
 if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
@@ -20,3 +20,27 @@ if ($f eq 'a,b,e') {print "ok 5\n";} else {print "not ok 5\n";}
 $f = 'a';
 $f = join $f, 'b', 'e', 'k';
 if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";}
+
+# 7,8 check for multiple read of tied objects
+{ package X;
+  sub TIESCALAR { my $x = 7; bless \$x };
+  sub FETCH { my $y = shift; $$y += 5 };
+  tie my $t, 'X';
+  my $r = join ':', $t, 99, $t, 99;
+  print "# expected '12:99:17:99' got '$r'\nnot " if $r ne '12:99:17:99';
+  print "ok 7\n";
+  $r = join '', $t, 99, $t, 99;
+  print "# expected '22992799' got '$r'\nnot " if $r ne '22992799';
+  print "ok 8\n";
+};
+
+# 9,10 and for multiple read of undef
+{ my $s = 5;
+  local ($^W, $SIG{__WARN__}) = ( 1, sub { $s+=4 } );
+  my $r = join ':', 'a', undef, $s, 'b', undef, $s, 'c';
+  print "# expected 'a::9:b::13:c' got '$r'\nnot " if $r ne 'a::9:b::13:c';
+  print "ok 9\n";
+  my $r = join '', 'a', undef, $s, 'b', undef, $s, 'c';
+  print "# expected 'a17b21c' got '$r'\nnot " if $r ne 'a17b21c';
+  print "ok 10\n";
+};
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index 78ca147bf3..a5949b68d8 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -919,14 +919,21 @@ test $bar->[3], 13;		# 206
 my $aaa;
 { my $bbbb = 0; $aaa = bless \$bbbb, B }
 
-test !$aaa, 1;
+test !$aaa, 1;			# 207
 
 unless ($aaa) {
-  test 'ok', 'ok';
+  test 'ok', 'ok';		# 208
 } else {
-  test 'is not', 'ok';
+  test 'is not', 'ok';		# 208
 }
 
+# check that overload isn't done twice by join
+{ my $c = 0;
+  package Join;
+  use overload '""' => sub { $c++ };
+  my $x = join '', bless([]), 'pq', bless([]);
+  main::test $x, '0pq1';		# 209
+};
 
 # Last test is:
-sub last {208}
+sub last {209}