Permalink
Fetching contributors…
Cannot retrieve contributors at this time
308 lines (224 sloc) 7.7 KB
use v6;
use Test;
# L<S03/Operator precedence>
=begin pod
Tests that each level bind tighter than the next by sampling some ops.
In between each precedence level are some tests that demonstrate the
proper separation of the two levels.
=end pod
plan 77;
# terms
# FIXME how do we test this?
# postfix method
{
my @a = 1,2,3;
is(++@a[2], 4, "bare postfix binds tighter than ++");
is(++@a.[2], 5, "dotted postfix binds tighter than ++");
}
# autoincrement
{
my $i = 2;
is(++$i ** 2, 9, "++ bind tighter than **");
is(--$i ** 2, 4, "-- does too");
}
# exponentiation
is(-2**2, -4, "** bind tighter than unary -");
isa-ok(~2**4, Str, "~2**4 is a string");
# symbolic unary
is(!0 * 2, 2, "unary ! binds tighter than *");
ok(!(0 * 2), "beh");
is(?2*2, 2, "binary -> numify causes reinterpretation as, binds tighter than *");
is -2**2 . abs, 4, "on left side . is looser than ** and left-to-right with unary -";
is -2**2 . abs + 1, 5, "on right side . is tighter than addition";
is -2**2 . abs.Str.ord, "4".ord, "on right side . is tighter than methodcall";
is -1 * -1 . abs, -1, "on left side . is tighter than *";
# multiplicative
is(4 + 3 * 2, 10, "* binds tighter than binary +");
is(2 - 2 div 2, 1, "div binds tighter than binary -");
is(2 - 2 / 2, 1 / 1, "/ binds tighter than binary -");
# additive
is(1 ~ 2 * 3, 16, "~ binds looser than *");
ok(?((1 ~ 2 & 12) == 12), "but tighter than &");
ok(?((2 + 2 | 4 - 1) == 4), "and + binds tighter than |");
# replication
is(2 x 2 + 3, "22222", "x binds looser than binary +");
is((2 x 2) + 3, 25, "doublecheck");
# concatenation
is(2 x 2 ~ 3, "223", "x binds tighter than binary ~");
ok(?((2 ~ 2 | 4 ~ 1) == 41), "and ~ binds tighter than |");
# junctive and
ok( ?( (1 & 2 | 3) ==3), '& binds tighter than |');
ok((!(1 & 2 | 3) < 2), "ditto");
ok(?((1 & 2 ^ 3) < 3), "and also ^");
ok(?(!(1 & 2 ^ 4) != 3), "blah blah blah");
# junctive or
{ # test that | and ^ are on the same level but parsefail
throws-like 'my Mu $a = (1 | 2 ^ 3)',
X::Syntax::NonListAssociative,
'| and ^ may not associate';
throws-like 'my Mu $a = (1 ^ 2 | 3)',
X::Syntax::NonListAssociative,
'^ and | may not associate';
};
{
my Mu $b = ((abs -1) ^ -1); # -> (1 ^ -1)
ok($b == 1, "this is true because only one is == 1");
};
# named unary
ok(0 < 2 <=> 1 < 2, "0 < 2 <=> 1 < 2 means 0 < 1 < 2");
# structural infix
is (1 | 3 <=> 2).gist, 'any(Less, More)', '<=> binds looser than |';
is (1 == 3 <=> 2).gist, 'True', '<=> binds tighter than ==';
throws-like '1 .. 2 .. 3',
X::Syntax::NonAssociative,
'identical .. is not associative';
throws-like '1 <=> 2 leg 3',
X::Syntax::NonAssociative,
'<=> and leg are not associative';
# chaining
is((0 != 1 && "foo"), "foo", "!= binds tighter than &&");
ok((0 || 1 == (2-1) == (0+1) || "foo") ne "foo", "== binds tighter than || also when chaning");
# tight and (&&)
# tight or (||, ^^, //)
is((1 && 0 ?? 2 !! 3), 3, "&& binds tighter than ??");
### FIXME - need also ||, otherwise we don't prove || and ?? are diff
# conditional
{
my $a = 0 ?? "yes" !! "no";
is($a, "no", "??!! binds tighter than =");
throws-like { EVAL '$a ?? $a = 42 !! $a = 43' },
X::Syntax::ConditionalOperator::PrecedenceTooLoose,
"Can't use assignop inside ??!!";
throws-like { EVAL '$a ?? $a += 42 !! $a = 43' },
X::Syntax::ConditionalOperator::PrecedenceTooLoose,
"Can't use meta-assignop inside ??!!";
# (my $b = 1) ?? "true" !! "false";
# is($b, 1, "?? !! just thrown away with = in parens");
};
# item assignment
# XXX this should be a todo, not a skip, but that
# messes up the rest of the file, somehow :(
{
my $c = 1, 2, 3;
is($c, 1, '$ = binds tighter than ,');
my $a = (1, 3) X (2, 4);
is($a, [1, 3], "= binds tighter than X");
}
# loose unary
my $x;
is((so $x = 42), True, "item assignment is tighter than true");
# comma
is(((not 1,42)[1]), 42, "not is tighter than comma");
# list infix
{
my @d;
ok (@d = 1,3 Z 2,4), "list infix tighter than list assignment, looser t than comma";
is(@d, [1 .. 4], "to complicate things further, it dwims");
}
{
my @b;
@b = ((1, 3) Z (2, 4));
is(@b, [1 .. 4], "parens work around this");
};
# RT #77848
{
throws-like '4 X+> 1...2',
X::Syntax::NonListAssociative,
'X+> must not associate with ...';
throws-like q['08:12:23'.split(':') Z* 60 X** reverse ^3],
X::Syntax::NonListAssociative,
'Z* and X** are non associative';
}
# list prefix
{
my $c = any flat 1, 2 Z 3, 4;
ok($c == 3, "any is less tight than comma and Z");
}
my @c = 1, 2, 3;
is(@c, [1,2,3], "@ = binds looser than ,");
# loose and
{
my $run = 1;
sub isfive (*@args) {
is(@args[0], 5, "First arg is 5, run " ~ $run++);
1;
}
# these are two tests per line, actually
# we should have a better way that doesn't just result in
# a wrong plan if gone wrong.
isfive(5) and isfive(5);
isfive 5 and isfive 5;
}
# loose or
# terminator
# superscript exponentiation
{
my $i = 2;
#?rakudo 2 skip 'superscript exponent associativity RT #130414'
is(++$i², 9, "++ bind tighter than superscript exponent");
is(--$i², 4, "-- does too");
#?rakudo todo 'superscript exponent associativity RT #130414'
is(2²**3, 256, "mixed exponent does right associative");
is(-2², -4, "superscript exponent binds tighter than unary -");
isa-ok(~2⁴, Str, "~2⁴ is a string");
is -2² . abs, 4, "on left side . is looser than superscript exponent and left-to-right with unary -";
is -2² . abs + 1, 5, "on right side . is tighter than addition";
is -2² . abs.Str.ord, "4".ord, "on right side . is tighter than methodcall";
}
# Contrary to Perl 5 there are no prototypes, and since normal built-ins
# are not defined as prefix ops, 'uc $a eq $A' actually parses as
# uc($a eq $A), not uc($a) eq $A.
# http://irclog.perlgeek.de/perl6/2009-07-14#i_1316200
#
# so uc(False) stringifies False to 'FALSE', and uc('0') is false. Phew.
is (uc "a" eq "A"), uc(False.Str), "uc has the correct precedence in comparison to eq";
# L<S03/Named unary precedence/my $i = int $x; # ILLEGAL>
throws-like 'int 4.5', X::Syntax::Confused, 'there is no more prefix:<int>';
# http://irclog.perlgeek.de/perl6/2009-07-14#i_1315249
ok ((1 => 2 => 3).key !~~ Pair), '=> is right-assoc (1)';
ok ((1 => 2 => 3).value ~~ Pair), '=> is right-assoc (2)';
# L<S03/Operator precedence/only works between identical operators>
throws-like '1, 2 Z 3, 4 X 5, 6',
X::Syntax::NonListAssociative,
'list associativity only works between identical operators';
{
# Check a 3 != 3 vs 3 !=3 parsing issue that can cropped up in Rakudo.
# Needs careful following of STD to get it right. :-)
my $r;
sub foo($x) { $r = $x }
foo 3 != 3;
is($r, False, 'sanity 3 != 3');
$r = True;
#?rakudo 2 todo 'Inequality (!=) misparsed as assignment RT #121108'
lives-ok { foo 3 !=3 }, '3 !=3 does not die';
is($r, False, 'ensure 3 !=3 gives same result as 3 != 3');
}
# RT #73266
{
try { EVAL 'say and die 73266' };
ok ~$! !~~ '73266', 'and after say is not interpreted as infix:<and>';
}
# RT #116100
{
my $s = set(); my $e = 5; $s = $s (|) $e;
is $s, Set.new(5), '(|) has correct precedence.';
}
# RT #114210
{
is not(0) + 1, 2,
'"not(0) + 1" is parsed as "(not 0) + 1"';
}
# RT #125210
throws-like 'my $lizmat = 42; ++$lizmat++',
X::Syntax::NonAssociative,
'prefix/postfix ++ are not associative';
# RT #128042
{
module RT128042 {
multi infix:<§>($,$) is tighter(&[+]) is export {0};
};
import RT128042;
#?rakudo todo 'RT 128042'
is (1 + 2 § 3), 1, 'exported multi has correct precedence';
}
# vim: ft=perl6