Double FETCH test

Message-ID: <20011119034256.I786@blackrider>

p4raw-id: //depot/perl@13092

1 files changed, 68 insertions, 0 deletions

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');
+}