1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#!./perl
# Test // and friends.
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
package main;
require './test.pl';
plan( tests => 34 );
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 reference');
$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( $@, '', "'/' correctly parsed as arithmetic operator" );
eval q# sub f ($):lvalue { $y } f $x /= 2; #;
is( $@, '', "'/=' correctly parsed as assigment 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');
|
