This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Optimise 'if ($a || $b)' and 'unless ($a && $b)' early exit
[perl5.git] / t / op / or.t
1 #!./perl
2
3 # Test || in weird situations.
4
5 BEGIN {
6     chdir 't' if -d 't';
7     @INC = '../lib';
8 }
9
10
11 package Countdown;
12
13 sub TIESCALAR {
14   my $class = shift;
15   my $instance = shift || undef;
16   return bless \$instance => $class;
17 }
18
19 sub FETCH {
20   print "# FETCH!  ${$_[0]}\n";
21   return ${$_[0]}--;
22 }
23
24
25 package main;
26 require './test.pl';
27
28 plan( tests => 11 );
29
30
31 my ($a, $b, $c);
32
33 $! = 1;
34 $a = $!;
35 my $a_str = sprintf "%s", $a;
36 my $a_num = sprintf "%d", $a;
37
38 $c = $a || $b;
39
40 is($c, $a_str, "comparison of string equality");
41 is($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
47 is($c, $a_str, "comparison of string equality");
48 is($c+0, $a_num, "comparison of numeric equality");   # force numeric context.
49
50 my $val = 3;
51
52 $c = $val || $b;
53 is($c, 3, "|| short-circuited as expected");
54
55 tie $a, 'Countdown', $val;
56
57 $c = $a;
58 is($c, 3,       'Single FETCH on tied scalar');
59
60 $c = $a;
61 is($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 = " ";
71 for (pos $x || pos $y) {
72     eval { $_++ };
73 }
74 is(pos($y) || $@, 1, "|| propagates lvaluish context");
75
76 my $aa, $bb, $cc;
77 $bb = 1;
78
79 my $res = 0;
80 # Well, really testing OP_DOR I guess
81 unless ($aa || $bb // $cc) {
82         $res = 1;
83 }
84 is($res, 0, "res is 0 after mixed OR/DOR");
85
86 $res = 0;
87 unless ($aa // $bb || $cc) {
88         $res = 1;
89 }
90 is($res, 0, "res is 0 after mixed DOR/OR");