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 => 41 );
  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 referece');
  27
  28 $x=1;
  29 is(($x err 0), 1,       '       err: left-hand operand defined');
  30
  31 $x = undef;
  32 is(($x err 1), 1,       '       err: left-hand operand undef');
  33
  34 $x='';
  35 is(($x err 0), '',      '       err: left-hand operand defined but empty');
  36
  37 like(([] err 0), qr/^ARRAY/,    '       err: left-hand operand a referece');
  38
  39 $x=undef;
  40 $x //= 1;
  41 is($x, 1,               '       //=: left-hand operand undefined');
  42
  43 $x //= 0;
  44 is($x, 1,               '//=: left-hand operand defined');
  45
  46 $x = '';
  47 $x //= 0;
  48 is($x, '',              '//=: left-hand operand defined but empty');
  49
  50 @ARGV = (undef, 0, 3);
  51 is(shift       // 7, 7, 'shift // ... works');
  52 is(shift()     // 7, 0, 'shift() // ... works');
  53 is(shift @ARGV // 7, 3, 'shift @array // ... works');
  54
  55 @ARGV = (3, 0, undef);
  56 is(pop         // 7, 7, 'pop // ... works');
  57 is(pop()       // 7, 0, 'pop() // ... works');
  58 is(pop @ARGV   // 7, 3, 'pop @array // ... works');
  59
  60 # Test that various syntaxes are allowed
  61
  62 for (qw(getc pos readline readlink undef umask <> <FOO> <$foo> -f)) {
  63     eval "sub { $_ // 0 }";
  64     is($@, '', "$_ // ... compiles");
  65 }
  66
  67 # Test for some ambiguous syntaxes
  68
  69 eval q# sub f ($) { } f $x / 2; #;
  70 is( $@, '' );
  71 eval q# sub f ($):lvalue { $y } f $x /= 2; #;
  72 is( $@, '' );
  73 eval q# sub f ($) { } f $x /2; #;
  74 like( $@, qr/^Search pattern not terminated/ );
  75 eval q# sub { print $fh / 2 } #;
  76 is( $@, '' );
  77 eval q# sub { print $fh /2 } #;
  78 like( $@, qr/^Search pattern not terminated/ );
  79
  80 # [perl #28123] Perl optimizes // away incorrectly
  81
  82 is(0 // 2, 0,           '       // : left-hand operand not optimized away');
  83 is('' // 2, '',         '       // : left-hand operand not optimized away');
  84 is(undef // 2, 2,       '       // : left-hand operand optimized away');
  85
  86 # [perl #32347] err should be a weak keyword
  87
  88 package weakerr;
  89
  90 sub err { "<@_>" }
  91 ::is( (shift() err 42), 42,     'err as an operator' );
  92 ::is( (shift err 42), 42,       'err as an operator, with ambiguity' );
  93 ::is( (err 2), "<2>",           'err as a function without parens' );
  94 ::is( err(2, 3), "<2 3>",       'err as a function with parens' );
  95 ::is( err(), "<>",              'err as a function without arguments' );
  96 ::is( err, "<>",                'err as a function without parens' );