Double FETCH test

Message-ID: <20011119034256.I786@blackrider>

p4raw-id: //depot/perl@13092

diff --git a/MANIFEST b/MANIFEST
index ee2406f..cfc6bbd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2182,6 +2182,7 @@ t/op/my_stash.t                   See if my Package works
 t/op/nothr5005.t               local @_ test which does not work under use5005threads
 t/op/numconvert.t              See if accessing fields does not change numeric values
 t/op/oct.t                     See if oct and hex work
+t/op/or.t                       See if || works in weird situations
 t/op/ord.t                     See if ord works
 t/op/override.t                        See if operator overriding works
 t/op/pack.t                    See if pack and unpack work

diff --git a/t/op/or.t b/t/op/or.t
new file mode 100644 (file)
index 0000000..1f40d61
--- /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');
+}