1#!./perl 2 3# Test // and friends. 4 5BEGIN { 6 chdir 't' if -d 't'; 7 require "./test.pl"; 8 set_up_inc('../lib'); 9} 10 11package main; 12 13plan( tests => 34 ); 14 15my($x); 16 17$x=1; 18is($x // 0, 1, ' // : left-hand operand defined'); 19 20$x = undef; 21is($x // 1, 1, ' // : left-hand operand undef'); 22 23$x=''; 24is($x // 0, '', ' // : left-hand operand defined but empty'); 25 26like([] // 0, qr/^ARRAY/, ' // : left-hand operand a reference'); 27 28$x=undef; 29$x //= 1; 30is($x, 1, ' //=: left-hand operand undefined'); 31 32$x //= 0; 33is($x, 1, '//=: left-hand operand defined'); 34 35$x = ''; 36$x //= 0; 37is($x, '', '//=: left-hand operand defined but empty'); 38 39@ARGV = (undef, 0, 3); 40is(shift // 7, 7, 'shift // ... works'); 41is(shift() // 7, 0, 'shift() // ... works'); 42is(shift @ARGV // 7, 3, 'shift @array // ... works'); 43 44@ARGV = (3, 0, undef); 45is(pop // 7, 7, 'pop // ... works'); 46is(pop() // 7, 0, 'pop() // ... works'); 47is(pop @ARGV // 7, 3, 'pop @array // ... works'); 48 49# Test that various syntaxes are allowed 50 51for (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 58eval q# sub f ($) { } f $x / 2; #; 59is( $@, '', "'/' correctly parsed as arithmetic operator" ); 60eval q# sub f ($):lvalue { $y } f $x /= 2; #; 61is( $@, '', "'/=' correctly parsed as assignment operator" ); 62eval q# sub f ($) { } f $x /2; #; 63like( $@, qr/^Search pattern not terminated/, 64 "Caught unterminated search pattern error message: empty subroutine" ); 65eval q# sub { print $fh / 2 } #; 66is( $@, '', 67 "'/' correctly parsed as arithmetic operator in sub with built-in function" ); 68eval q# sub { print $fh /2 } #; 69like( $@, 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 74is(0 // 2, 0, ' // : left-hand operand not optimized away'); 75is('' // 2, '', ' // : left-hand operand not optimized away'); 76is(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 81my $x = 0; 82my $y = 0; 83 84$x // 1 and $y = 1; 85is($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 90if ($x // 1) { 91 $y = 1; 92} 93is($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'; 100is($y, 'cat', 'chained or/dor behaves correctly'); 101