1#!./perl 2 3# Test || in weird situations. 4 5BEGIN { 6 chdir 't' if -d 't'; 7 require './test.pl'; 8 set_up_inc('../lib'); 9} 10 11 12package Countdown; 13 14sub TIESCALAR { 15 my $class = shift; 16 my $instance = shift || undef; 17 return bless \$instance => $class; 18} 19 20sub FETCH { 21 print "# FETCH! ${$_[0]}\n"; 22 return ${$_[0]}--; 23} 24 25 26package main; 27 28plan( tests => 14 ); 29 30 31my ($a, $b, $c); 32 33$! = 1; 34$a = $!; 35my $a_str = sprintf "%s", $a; 36my $a_num = sprintf "%d", $a; 37 38$c = $a || $b; 39 40is($c, $a_str, "comparison of string equality"); 41is($c+0, $a_num, "comparison of numeric equality"); # force numeric context. 42 43$a =~ /./g or die "Match failed for some reason"; # Make $a magic 44 45$c = $a || $b; 46 47is($c, $a_str, "comparison of string equality"); 48is($c+0, $a_num, "comparison of numeric equality"); # force numeric context. 49 50my $val = 3; 51 52$c = $val || $b; 53is($c, 3, "|| short-circuited as expected"); 54 55tie $a, 'Countdown', $val; 56 57$c = $a; 58is($c, 3, 'Single FETCH on tied scalar'); 59 60$c = $a; 61is($c, 2, ' $tied = $var'); 62 63$c = $a || $b; 64 65{ 66 local $TODO = 'Double FETCH'; 67 is($c, 1, ' $tied || $var'); 68} 69 70$y = " "; 71for (pos $x || pos $y) { 72 eval { $_++ }; 73} 74is(pos($y) || $@, 1, "|| propagates lvaluish context to its rhs"); 75 76$x = " "; 77pos $x = 1; 78for (pos $x || pos $y) { 79 eval { $_++ }; 80} 81is(pos($x) || $@, 2, "|| propagates lvaluish context to its lhs"); 82 83for ($h{k} || $h{l}) {} 84ok(!exists $h{k}, 85 "|| does not propagate lvaluish cx to a subscript on its lhs"); 86ok(!exists $h{l}, 87 "|| does not propagate lvaluish cx to a subscript on its rhs"); 88 89my $aa, $bb, $cc; 90$bb = 1; 91 92my $res = 0; 93# Well, really testing OP_DOR I guess 94unless ($aa || $bb // $cc) { 95 $res = 1; 96} 97is($res, 0, "res is 0 after mixed OR/DOR"); 98 99$res = 0; 100unless ($aa // $bb || $cc) { 101 $res = 1; 102} 103is($res, 0, "res is 0 after mixed DOR/OR"); 104