From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 19 Nov 2001 03:42:56 +0000 (-0500)
Subject: Double FETCH test
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a28061a821c52d342100af483d5c6b04831763c;hp=1d2b156ae906ef7a9a997cd88768c12dec800b98;p=p5sagit%2Fp5-mst-13.2.git

Double FETCH test
Message-ID: <20011119034256.I786@blackrider>

p4raw-id: //depot/perl@13092
---

diff --git a/MANIFEST b/MANIFEST
index ee2406f..cfc6bbd 100644
--- 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
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');
+}