Lots of consting

[p5sagit/p5-mst-13.2.git] / t / op / dor.t

#!./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' );