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 => 8 );
  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);
  41 is($c+0, $a_num);   # 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);
  48 is($c+0, $a_num);   # force numeric context.
  49
  50 my $val = 3;
  51
  52 $c = $val || $b;
  53 is($c, 3);
  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 }