summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/lib/warnings/op12
-rw-r--r--t/op/dor.t96
2 files changed, 108 insertions, 0 deletions
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index cc9be27cd1..69b36b0d67 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -682,6 +682,18 @@ EXPECT
Value of readdir() operator can be "0"; test with defined() at - line 4.
########
# op.c
+use warnings 'misc';
+open FH, "<abc";
+$_ = <FH> err $_ = 1;
+($_ = <FH>) // ($_ = 1);
+opendir DH, ".";
+$_ = readdir DH err $_ = 1;
+$_ = <*> err $_ = 1;
+%a = (1,2,3,4) ;
+$_ = each %a err $_ = 1;
+EXPECT
+########
+# op.c
use warnings 'redefine' ;
sub fred {}
sub fred {}
diff --git a/t/op/dor.t b/t/op/dor.t
new file mode 100644
index 0000000000..079631a31d
--- /dev/null
+++ b/t/op/dor.t
@@ -0,0 +1,96 @@
+#!./perl
+
+# Test // and friends.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+package main;
+require './test.pl';
+
+plan( tests => 41 );
+
+my($x);
+
+$x=1;
+is($x // 0, 1, ' // : left-hand operand defined');
+
+$x = undef;
+is($x // 1, 1, ' // : left-hand operand undef');
+
+$x='';
+is($x // 0, '', ' // : left-hand operand defined but empty');
+
+like([] // 0, qr/^ARRAY/, ' // : left-hand operand a referece');
+
+$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(([] err 0), qr/^ARRAY/, ' err: left-hand operand a referece');
+
+$x=undef;
+$x //= 1;
+is($x, 1, ' //=: left-hand operand undefined');
+
+$x //= 0;
+is($x, 1, '//=: left-hand operand defined');
+
+$x = '';
+$x //= 0;
+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( $@, '' );
+eval q# sub f ($):lvalue { $y } f $x /= 2; #;
+is( $@, '' );
+eval q# sub f ($) { } f $x /2; #;
+like( $@, qr/^Search pattern not terminated/ );
+eval q# sub { print $fh / 2 } #;
+is( $@, '' );
+eval q# sub { print $fh /2 } #;
+like( $@, qr/^Search pattern not terminated/ );
+
+# [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');
+
+# [perl #32347] err should be a weak keyword
+
+package weakerr;
+
+sub err { "<@_>" }
+::is( (shift() err 42), 42, 'err as an operator' );
+::is( (shift err 42), 42, 'err as an operator, with ambiguity' );
+::is( (err 2), "<2>", 'err as a function without parens' );
+::is( err(2, 3), "<2 3>", 'err as a function with parens' );
+::is( err(), "<>", 'err as a function without arguments' );
+::is( err, "<>", 'err as a function without parens' );