t/op/dor.t

   1 #!./perl
   2
   3 # Test // and friends.
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8 }
   9
  10 package main;
  11 require './test.pl';
  12
  13 plan( tests => 34 );
  14
  15 my($x);
  16
  17 $x=1;
  18 is($x // 0, 1,          '       // : left-hand operand defined');
  19
  20 $x = undef;
  21 is($x // 1, 1,          '       // : left-hand operand undef');
  22
  23 $x='';
  24 is($x // 0, '',         '       // : left-hand operand defined but empty');
  25
  26 like([] // 0, qr/^ARRAY/,       '       // : left-hand operand a reference');
  27
  28 $x=undef;
  29 $x //= 1;
  30 is($x, 1,               '       //=: left-hand operand undefined');
  31
  32 $x //= 0;
  33 is($x, 1,               '//=: left-hand operand defined');
  34
  35 $x = '';
  36 $x //= 0;
  37 is($x, '',              '//=: left-hand operand defined but empty');
  38
  39 @ARGV = (undef, 0, 3);
  40 is(shift       // 7, 7, 'shift // ... works');
  41 is(shift()     // 7, 0, 'shift() // ... works');
  42 is(shift @ARGV // 7, 3, 'shift @array // ... works');
  43
  44 @ARGV = (3, 0, undef);
  45 is(pop         // 7, 7, 'pop // ... works');
  46 is(pop()       // 7, 0, 'pop() // ... works');
  47 is(pop @ARGV   // 7, 3, 'pop @array // ... works');
  48
  49 # Test that various syntaxes are allowed
  50
  51 for (qw(getc pos readline readlink undef umask <> <FOO> <$foo> -f)) {
  52     eval "sub { $_ // 0 }";
  53     is($@, '', "$_ // ... compiles");
  54 }
  55
  56 # Test for some ambiguous syntaxes
  57
  58 eval q# sub f ($) { } f $x / 2; #;
  59 is( $@, '', "'/' correctly parsed as arithmetic operator" );
  60 eval q# sub f ($):lvalue { $y } f $x /= 2; #;
  61 is( $@, '', "'/=' correctly parsed as assigment operator" );
  62 eval q# sub f ($) { } f $x /2; #;
  63 like( $@, qr/^Search pattern not terminated/,
  64     "Caught unterminated search pattern error message: empty subroutine" );
  65 eval q# sub { print $fh / 2 } #;
  66 is( $@, '',
  67     "'/' correctly parsed as arithmetic operator in sub with built-in function" );
  68 eval q# sub { print $fh /2 } #;
  69 like( $@, qr/^Search pattern not terminated/,
  70     "Caught unterminated search pattern error message: sub with built-in function" );
  71
  72 # [perl #28123] Perl optimizes // away incorrectly
  73
  74 is(0 // 2, 0,           '       // : left-hand operand not optimized away');
  75 is('' // 2, '',         '       // : left-hand operand not optimized away');
  76 is(undef // 2, 2,       '       // : left-hand operand optimized away');
  77
  78 # Test that OP_DORs other branch isn't run when arg is defined
  79 # // returns the value if its defined, and we must test its
  80 # truthness after
  81 my $x = 0;
  82 my $y = 0;
  83
  84 $x // 1 and $y = 1;
  85 is($y, 0, 'y is still 0 after "$x // 1 and $y = 1"');
  86
  87 $y = 0;
  88 # $x is defined, so its value 0 is returned to the if block
  89 # and the block is skipped
  90 if ($x // 1) {
  91     $y = 1;
  92 }
  93 is($y, 0, 'if ($x // 1) exited out early since $x is defined and 0');
  94
  95 # This is actually (($x // $z) || 'cat'), so 0 from first dor
  96 # evaluates false, we should see 'cat'.
  97 $y = undef;
  98
  99 $y = $x // $z || 'cat';
 100 is($y, 'cat', 'chained or/dor behaves correctly');