fix utf char > IV_MAX on 32-bit platforms

[perl5.git] / t / op / dor.t

diff --git a/t/op/dor.t b/t/op/dor.t
index 56920c2..4b89fd0 100644 (file)
--- a/t/op/dor.t
+++ b/t/op/dor.t
@@ -4,13 +4,13 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require "./test.pl";
+    set_up_inc('../lib');
 }
 
 package main;
-require './test.pl';
 
-plan( tests => 9 );
+plan( tests => 34 );
 
 my($x);
 
@@ -23,22 +23,78 @@ is($x // 1, 1,              '       // : left-hand operand undef');
 $x='';
 is($x // 0, '',                '       // : left-hand operand defined but empty');
 
-$x=1;
-is(($x err 0), 1,      '       err: left-hand operand defined');
-
-$x = undef;
-is(($x err 1), 1,      '       err: left-hand operand undef');
-
-$x='';
-is(($x err 0), '',     '       err: left-hand operand defined but empty');
+like([] // 0, qr/^ARRAY/,      '       // : left-hand operand a reference');
 
 $x=undef;
 $x //= 1;
 is($x, 1,              '       //=: left-hand operand undefined');
 
 $x //= 0;
-is($x, 1,              '       //=: left-hand operand defined');
+is($x, 1,              '//=: left-hand operand defined');
 
 $x = '';
 $x //= 0;
-is($x, '',             '       //=: left-hand operand defined but empty');
+is($x, '',             '//=: left-hand operand defined but empty');
+
+@ARGV = (undef, 0, 3);
+is(shift       // 7, 7,        'shift // ... works');
+is(shift()     // 7, 0,        'shift() // ... works');
+is(shift @ARGV // 7, 3,        'shift @array // ... works');
+
+@ARGV = (3, 0, undef);
+is(pop         // 7, 7,        'pop // ... works');
+is(pop()       // 7, 0,        'pop() // ... works');
+is(pop @ARGV   // 7, 3,        'pop @array // ... works');
+
+# Test that various syntaxes are allowed
+
+for (qw(getc pos readline readlink undef umask <> <FOO> <$foo> -f)) {
+    eval "sub { $_ // 0 }";
+    is($@, '', "$_ // ... compiles");
+}
+
+# Test for some ambiguous syntaxes
+
+eval q# sub f ($) { } f $x / 2; #;
+is( $@, '', "'/' correctly parsed as arithmetic operator" );
+eval q# sub f ($):lvalue { $y } f $x /= 2; #;
+is( $@, '', "'/=' correctly parsed as assignment operator" );
+eval q# sub f ($) { } f $x /2; #;
+like( $@, qr/^Search pattern not terminated/,
+    "Caught unterminated search pattern error message: empty subroutine" );
+eval q# sub { print $fh / 2 } #;
+is( $@, '',
+    "'/' correctly parsed as arithmetic operator in sub with built-in function" );
+eval q# sub { print $fh /2 } #;
+like( $@, qr/^Search pattern not terminated/,
+    "Caught unterminated search pattern error message: sub with built-in function" );
+
+# [perl #28123] Perl optimizes // away incorrectly
+
+is(0 // 2, 0,          '       // : left-hand operand not optimized away');
+is('' // 2, '',                '       // : left-hand operand not optimized away');
+is(undef // 2, 2,      '       // : left-hand operand optimized away');
+
+# Test that OP_DORs other branch isn't run when arg is defined
+# // returns the value if its defined, and we must test its
+# truthness after
+my $x = 0;
+my $y = 0;
+
+$x // 1 and $y = 1;
+is($y, 0, 'y is still 0 after "$x // 1 and $y = 1"');
+
+$y = 0;
+# $x is defined, so its value 0 is returned to the if block
+# and the block is skipped
+if ($x // 1) {
+    $y = 1;
+}
+is($y, 0, 'if ($x // 1) exited out early since $x is defined and 0');
+
+# This is actually (($x // $z) || 'cat'), so 0 from first dor
+# evaluates false, we should see 'cat'.
+$y = undef;
+
+$y = $x // $z || 'cat';
+is($y, 'cat', 'chained or/dor behaves correctly');