Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

869 lines (721 sloc) 30.826 kB
use v6;
use Test;
plan 304;
=begin pod
Hyper operators L<S03/"Hyper operators">
=end pod
# L<S03/Hyper operators>
# binary infix
my @r;
my @e;
{
@r = (1, 2, 3) »+« (2, 4, 6);
@e = (3, 6, 9);
is(~@r, ~@e, "hyper-sum two arrays");
@r = (1, 2, 3) »-« (2, 4, 6);
@e = (-1, -2, -3);
is(~@r, ~@e, "hyper-subtract two arrays");
@r = (1, 2, 3) »*« (2, 4, 6);
@e = (2, 8, 18);
is(~@r, ~@e, "hyper-multiply two arrays");
@r = (1, 2, 3) »x« (3, 2, 1);
@e = ('111', '22', '3');
is(~@r, ~@e, "hyper-x two arrays");
@r = (1, 2, 3) »xx« (3, 2, 1);
@e = ((1,1,1), (2,2), (3));
is(~@r, ~@e, "hyper-xx two arrays");
@r = (20, 40, 60) »div« (2, 5, 10);
@e = (10, 8, 6);
is(~@r, ~@e, "hyper-divide two arrays");
@r = (1, 2, 3) »+« (10, 20, 30) »*« (2, 3, 4);
@e = (21, 62, 123);
is(~@r, ~@e, "precedence - »+« vs »*«");
}
{
@r = (1, 2, 3) >>+<< (2, 4, 6);
@e = (3, 6, 9);
is(~@r, ~@e, "hyper-sum two arrays ASCII notation");
@r = (1, 2, 3) >>-<< (2, 4, 6);
@e = (-1, -2, -3);
is(~@r, ~@e, "hyper-subtract two arrays ASCII notation");
@r = (1, 2, 3) >>*<< (2, 4, 6);
@e = (2, 8, 18);
is(~@r, ~@e, "hyper-multiply two arrays ASCII notation");
@r = (1, 2, 3) >>x<< (3, 2, 1);
@e = ('111', '22', '3');
is(~@r, ~@e, "hyper-x two arrays ASCII notation");
@r = (1, 2, 3) >>xx<< (3, 2, 1);
@e = ((1,1,1), (2,2), (3));
is(~@r, ~@e, "hyper-xx two arrays ASCII notation");
@r = (20, 40, 60) >>div<< (2, 5, 10);
@e = (10, 8, 6);
is(~@r, ~@e, "hyper-divide two arrays ASCII notation");
@r = (1, 2, 3) >>+<< (10, 20, 30) >>*<< (2, 3, 4);
@e = (21, 62, 123);
is(~@r, ~@e, "precedence - >>+<< vs >>*<< ASCII notation");
};
{ # unary postfix
my @r = (1, 2, 3);
@r»++;
my @e = (2, 3, 4);
is(~@r, ~@e, "hyper auto increment an array");
@r = (1, 2, 3);
@r>>++;
@e = (2, 3, 4);
is(~@r, ~@e, "hyper auto increment an array ASCII notation");
};
{ # unary prefix
my @r;
@r = -« (3, 2, 1);
my @e = (-3, -2, -1);
is(~@r, ~@e, "hyper op on assignment/pipeline");
@r = -<< (3, 2, 1);
@e = (-3, -2, -1);
is(~@r, ~@e, "hyper op on assignment/pipeline ASCII notation");
};
{ # dimension upgrade - ASCII
my @r;
@r = (1, 2, 3) >>+>> 1;
my @e = (2, 3, 4);
is(~@r, ~@e, "auto dimension upgrade on rhs ASCII notation");
@r = 2 <<*<< (10, 20, 30);
@e = (20, 40, 60);
is(~@r, ~@e, "auto dimension upgrade on lhs ASCII notation");
}
{ # extension
@r = (1,2,3,4) >>~>> <A B C D E>;
@e = <1A 2B 3C 4D>;
is(~@r, ~@e, "list-level element truncate on rhs ASCII notation");
@r = (1,2,3,4,5) <<~<< <A B C D>;
@e = <1A 2B 3C 4D>;
is(~@r, ~@e, "list-level element truncate on lhs ASCII notation");
@r = (1,2,3,4) >>~>> <A B C>;
@e = <1A 2B 3C 4A>;
is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
@r = (1,2,3) <<~<< <A B C D>;
@e = <1A 2B 3C 1D>;
is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
@r = (1,2,3,4) >>~>> <A B>;
@e = <1A 2B 3A 4B>;
is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
@r = (1,2) <<~<< <A B C D>;
@e = <1A 2B 1C 2D>;
is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
@r = (1,2,3,4) >>~>> <A>;
@e = <1A 2A 3A 4A>;
is(~@r, ~@e, "list-level element extension on rhs ASCII notation");
@r = (1,) <<~<< <A B C D>;
@e = <1A 1B 1C 1D>;
is(~@r, ~@e, "list-level element extension on lhs ASCII notation");
@r = (1,2,3,4) >>~>> 'A';
@e = <1A 2A 3A 4A>;
is(~@r, ~@e, "scalar element extension on rhs ASCII notation");
@r = 1 <<~<< <A B C D>;
@e = <1A 1B 1C 1D>;
is(~@r, ~@e, "scalar element extension on lhs ASCII notation");
};
{ # dimension upgrade - unicode
@r = (1,2,3,4) »~» <A B C D E>;
@e = <1A 2B 3C 4D>;
is(~@r, ~@e, "list-level element truncate on rhs unicode notation");
@r = (1,2,3,4,5) «~« <A B C D>;
@e = <1A 2B 3C 4D>;
is(~@r, ~@e, "list-level element truncate on lhs unicode notation");
@r = (1,2,3,4) »~» <A B C>;
@e = <1A 2B 3C 4A>;
is(~@r, ~@e, "list-level element extension on rhs unicode notation");
@r = (1,2,3) «~« <A B C D>;
@e = <1A 2B 3C 1D>;
is(~@r, ~@e, "list-level element extension on lhs unicode notation");
@r = (1,2,3,4) »~» <A B>;
@e = <1A 2B 3A 4B>;
is(~@r, ~@e, "list-level element extension on rhs unicode notation");
@r = (1,2) «~« <A B C D>;
@e = <1A 2B 1C 2D>;
is(~@r, ~@e, "list-level element extension on lhs unicode notation");
@r = (1,2,3,4) »~» <A>;
@e = <1A 2A 3A 4A>;
is(~@r, ~@e, "list-level element extension on rhs unicode notation");
@r = (1,) «~« <A B C D>;
@e = <1A 1B 1C 1D>;
is(~@r, ~@e, "list-level element extension on lhs unicode notation");
@r = (1,2,3,4) »~» 'A';
@e = <1A 2A 3A 4A>;
is(~@r, ~@e, "scalar element extension on rhs unicode notation");
@r = 1 «~« <A B C D>;
@e = <1A 1B 1C 1D>;
is(~@r, ~@e, "scalar element extension on lhs unicode notation");
};
{ # unary postfix with integers
my @r;
@r = (1, 4, 9)».sqrt;
my @e = (1, 2, 3);
is(~@r, ~@e, "method call on integer list elements");
@r = (1, 4, 9)>>.sqrt;
@e = (1, 2, 3);
is(~@r, ~@e, "method call on integer list elements (ASCII)");
}
{
my (@r, @e);
(@r = (1, 4, 9))»++;
@e = (2, 5, 10);
is(~@r, ~@e, "operator call on integer list elements");
(@r = (1, 4, 9)).»++;
is(~@r, ~@e, "operator call on integer list elements (Same thing, dot form)");
}
# RT #122342
{
my (@r, @e);
@e = (2, 5, 10);
(@r = (1, 4, 9)).».++;
is(~@r, ~@e, "postfix operator (dotted form) on integer list elements after unary postfix hyper operator");
(@r = (1, 4, 9)).>>.++;
is(~@r, ~@e, "postfix operator (dotted form) on integer list elements after unary postfix hyper operator (ASCII)");
(@r = (1, 4, 9))\ .»\ .++;
@e = (2, 5, 10);
is(~@r, ~@e, "postfix operator (dotted form) on integer list elements after unary postfix hyper operator (unspace form)");
{ # non-wordy postfix operator
sub postfix:<???>($) {
return 42;
}
my @a = 1 .. 3;
is @a»???, (42, 42, 42), 'non-wordy postfix operator';
is @a>>???, (42, 42, 42), 'non-wordy postfix operator, ASCII';
is @a».???, (42, 42, 42), 'non-wordy postfix operator, dotted form';
is @a>>.???, (42, 42, 42), 'non-wordy postfix operator, ASCII, dotted form';
}
{ # wordy postfix operator
sub postfix:<foo>($) {
return 42;
}
my @a = 1 .. 3;
is @a»foo, (42, 42, 42), 'wordy postfix operator';
is @a>>foo, (42, 42, 42), 'wordy postfix operator, ASCII';
throws-like { @a».foo }, X::Method::NotFound,
message => "No such method 'foo' for invocant of type 'Int'",
'wordy postfix operator: dotted form not allowed';
throws-like { @a>>.foo }, X::Method::NotFound,
message => "No such method 'foo' for invocant of type 'Int'",
'wordy postfix operator, ASCII: dotted form not allowed';
}
{ # no confusion with postfix:<i> (see S32-Numeric)
my class D { method i { 42 } };
is D.i, 42, 'manually defined method i is not confused with postfix:<i>';
is D.i(), 42, 'manually defined method i is not confused with postfix:<i>';
is 4i, Complex.new(0, 4), 'postfix:<i> still works';
is 4\i, Complex.new(0, 4), 'postfix:<i> still works (2)';
throws-like { 4.i }, X::Method::NotFound,
message => "No such method 'i' for invocant of type 'Int'",
'dotted form of postfix:<i> fails';
is (2,3)»i, (Complex.new(0, 2), Complex.new(0, 3)),
'postfix:<i> works on list elements';
is (2,3)>>i, (Complex.new(0, 2), Complex.new(0, 3)),
'postfix:<i> works on list elements (ASCII form)';
}
{
my @a = ( { 42 }, { 43 } );
is @a».(), (42, 43), 'calling .() on list elements works';
is @a>>.(), (42, 43), 'calling .() on list elements works, ASCII';
}
};
# postfix forms
{ # unary postfix again, but with a twist
my @r;
my @e = (1, 2, 3);
@r = ("f", "oo", "bar")».chars;
is(~@r, ~@e, "method call on list elements");
@r = ("f", "oo", "bar").».chars;
is(~@r, ~@e, "method call on list elements (Same thing, dot form)");
@r = ("f", "oo", "bar")>>.chars;
is(~@r, ~@e, "method call on list elements (ASCII)");
# RT #74890 analogue
@r = ("f", "oo", "bar").>>.chars;
is(~@r, ~@e, "method call on list elements (ASCII, Same thing, dot form)");
# RT 122342
@r = ("f", "oo", "bar")»."chars"();
is(~@r, ~@e, "method call on list elements (quoted method name)");
@r = ("f", "oo", "bar")>>."chars"();
is(~@r, ~@e, "method call on list elements (ASCII, quoted method name)");
};
{ # unary postfix on a user-defined object
my $t;
class FooTest { method bar { 42 } }; $t = FooTest.new.bar;
is($t, 42, 'plain method call works OK');
my @r;
class FooTest2 { method bar { 42 } }; @r = (FooTest2.new)>>.bar;
my @e = (42);
is(~@r, ~@e, "hyper-method-call on list of user-defined objects");
};
{ # distribution for unary prefix
my @r;
@r = -«([1, 2], [3, [4, 5]]);
my @e = ([-1, -2], [-3, [-4, -5]]);
is(~@r, ~@e, "distribution for unary prefix");
is-deeply(@r, @e, "distribution for unary prefix, deep comparison");
};
{ # distribution for unary postfix autoincrement
my @r;
@r = [1, 2], [3, [4, 5]];
@r»++;
my @e = [2, 3], [4, [5, 6]];
is(~@r, ~@e, "distribution for unary postfix autoincr");
is-deeply(@r, @e, "distribution for unary postfix autoincr, deep comparison");
is @e»[1], '3 5 6', "nodal postcircumfixes do not distribute";
is @e».elems, '2 2', "nodal methods do not distribute (elems)";
is @e».reverse, '3 2 5 6 4', "nodal methods do not distribute (reverse)";
# XXX need to test all the things
};
#?DOES 3
{ # distribution for binary infix - ASCII
my @r;
@r = (1, 2, [3, 4]) >>+<< (4, 5, [6, 7]);
my @e = (5, 7, [9, 11]);
is(~@r, ~@e, "distribution for binary infix, same shape, ASCII");
is-deeply(@r, @e, "distribution for binary infix, same shape, ASCII, deep comparison");
@r = (1, 2, [3, 4]) >>+>> (5, 6, 7);
@e = (6, 8, [10, 11]);
is(~@r, ~@e, "distribution for binary infix, dimension upgrade, ASCII");
is-deeply(@r, @e, "distribution for binary infix, dimension upgrade, ASCII, deep comparison");
@r = ([1, 2], 3) <<+>> (4, [5, 6]);
@e = ([5, 6], [8, 9]);
is(~@r, ~@e, "distribution for binary infix, S03 cross-upgrade, ASCII");
is-deeply(@r, @e, "distribution for binary infix, S03 cross-upgrade, ASCII, deep comparison");
};
#?DOES 3
{ # distribution for binary infix - unicode
my @r;
@r = (1, 2, [3, 4]) »+« (4, 5, [6, 7]);
my @e = (5, 7, [9, 11]);
is(~@r, ~@e, "distribution for binary infix, same shape");
is-deeply(@r, @e, "distribution for binary infix, same shape, deep comparison");
@r = (1, 2, [3, 4]) »+» (5, 6, 7);
@e = (6, 8, [10, 11]);
is(~@r, ~@e, "distribution for binary infix, dimension upgrade");
is-deeply(@r, @e, "distribution for binary infix, dimension upgrade, deep comparison");
@r = ([1, 2], 3) «+» (4, [5, 6]);
@e = ([5, 6], [8, 9]);
is(~@r, ~@e, "distribution for binary infix, S03 cross-upgrade");
is-deeply(@r, @e, "distribution for binary infix, S03 cross-upgrade, deep comparison");
};
{ # regression test, ensure that hyper works on arrays
my @r1;
my @r2;
my @e1 = (2, 4, 6);
my @a = (1, 2, 3);
@r1 = @a >>+<< @a;
is(~@r1, ~@e1, "hyper op works on variables, too.");
}
{
my @a = (1, 2, 3);
my @e2 = (2, 3, 4);
my @r2 = @a >>+>> 1;
is(~@r2, ~@e2, "hyper op and correctly promotes scalars");
};
# mixed hyper and reduce metaops -
# this unveils a spec bug as << recurses into arrays and [+] never gets applied,
# so we disable the entire chunk for now.
=begin todo_unspecced
is ~([+]<< ([1,2,3], [4,5,6])), "6 15", "mixed hyper and reduce metaop ([+]<<) works";
## XXX: Test for [+]<<<< - This is unspecced, commenting it out
#is ~([+]<<<< ([[1,2],[3,4]],[[5,6],[7,8]])), "3 7 11 15",
# "mixed double hyper and reduce metaop ([+]<<<<) works";
is ~([+]« [1,2,3], [4,5,6]), "6 15",
"mixed Unicode hyper and reduce metaop ([+]«) works";
=end todo_unspecced
#?niecza skip 'does not work; recurses into hash'
#?rakudo skip 'nom regression: possible spec change/improvement RT #124513'
#?DOES 2
{ # hyper dereferencing
my @array = (
{ key => 'val' },
{ key => 'val' },
{ key => 'val' }
);
my $full = join '', EVAL '@array>>.<key>';
is($full, 'valvalval', 'hyper-dereference an array');
my $part = join '', EVAL '@array[0,1]>>.<key>';
is($part, 'valval', 'hyper-dereference an array slice');
}
#?DOES 4
{ # junction hyper -- regression?
my @a = 1..3;
my @b = 4..6;
ok ?(@a »|« @b), '»|« hyperjunction evals';
ok ?(@a >>|<< @b), '>>|<< hyperjunction evals, ASCII';
ok ?(@a »&« @b), '»&« hyperjunction evals';
ok ?(@a >>&<< @b), '>>&<< hyperjunction evals, ASCII';
}
# test hypers on hashes
{
my %a = a => 1, b => 2, c => 3;
my %b = a => 5, b => 6, c => 7;
my %c = a => 1, b => 2;
my %d = a => 5, b => 6;
my %r;
%r = %a >>+<< %b;
is +%r, 3, 'hash - >>+<< result has right number of keys (same keys)';
is %r<a>, 6, 'hash - correct result from >>+<< (same keys)';
is %r<b>, 8, 'hash - correct result from >>+<< (same keys)';
is %r<c>, 10, 'hash - correct result from >>+<< (same keys)';
%r = %a »+« %d;
is +%r, 3, 'hash - »+« result has right number of keys (union test)';
is %r<a>, 6, 'hash - correct result from »+« (union test)';
is %r<b>, 8, 'hash - correct result from »+« (union test)';
is %r<c>, 3, 'hash - correct result from »+« (union test)';
%r = %c >>+<< %b;
is +%r, 3, 'hash - >>+<< result has right number of keys (union test)';
is %r<a>, 6, 'hash - correct result from >>+<< (union test)';
is %r<b>, 8, 'hash - correct result from >>+<< (union test)';
is %r<c>, 7, 'hash - correct result from >>+<< (union test)';
%r = %a <<+>> %b;
is +%r, 3, 'hash - <<+>> result has right number of keys (same keys)';
is %r<a>, 6, 'hash - correct result from <<+>> (same keys)';
is %r<b>, 8, 'hash - correct result from <<+>> (same keys)';
is %r<c>, 10, 'hash - correct result from <<+>> (same keys)';
%r = %a <<+>> %d;
is +%r, 2, 'hash - <<+>> result has right number of keys (intersection test)';
is %r<a>, 6, 'hash - correct result from <<+>> (intersection test)';
is %r<b>, 8, 'hash - correct result from <<+>> (intersection test)';
%r = %c <<+>> %b;
is +%r, 2, 'hash - <<+>> result has right number of keys (intersection test)';
is %r<a>, 6, 'hash - correct result from <<+>> (intersection test)';
is %r<b>, 8, 'hash - correct result from <<+>> (intersection test)';
%r = %a >>+>> %c;
is +%r, 3, 'hash - >>+>> result has right number of keys';
is %r<a>, 2, 'hash - correct result from >>+>>';
is %r<b>, 4, 'hash - correct result from >>+>>';
is %r<c>, 3, 'hash - correct result from >>+>>';
%r = %c >>+>> %b;
is +%r, 2, 'hash - >>+>> result has right number of keys';
is %r<a>, 6, 'hash - correct result from >>+>>';
is %r<b>, 8, 'hash - correct result from >>+>>';
%r = %c <<+<< %a;
is +%r, 3, 'hash - <<+<< result has right number of keys';
is %r<a>, 2, 'hash - correct result from <<+<<';
is %r<b>, 4, 'hash - correct result from <<+<<';
is %r<c>, 3, 'hash - correct result from <<+<<';
%r = %b <<+<< %c;
is +%r, 2, 'hash - <<+<< result has right number of keys';
is %r<a>, 6, 'hash - correct result from <<+<<';
is %r<b>, 8, 'hash - correct result from <<+<<';
}
{
my %a = a => 1, b => 2, c => 3;
my %r = -<<%a;
is +%r, 3, 'hash - -<< result has right number of keys';
is %r<a>, -1, 'hash - correct result from -<<';
is %r<b>, -2, 'hash - correct result from -<<';
is %r<c>, -3, 'hash - correct result from -<<';
%r = --<<%a;
is +%r, 3, 'hash - --<< result has right number of keys';
is %r<a>, 0, 'hash - correct result from --<<';
is %r<b>, 1, 'hash - correct result from --<<';
is %r<c>, 2, 'hash - correct result from --<<';
is +%a, 3, 'hash - --<< result has right number of keys';
is %a<a>, 0, 'hash - correct result from --<<';
is %a<b>, 1, 'hash - correct result from --<<';
is %a<c>, 2, 'hash - correct result from --<<';
%r = %a>>++;
is +%r, 3, 'hash - >>++ result has right number of keys';
is %r<a>, 0, 'hash - correct result from >>++';
is %r<b>, 1, 'hash - correct result from >>++';
is %r<c>, 2, 'hash - correct result from >>++';
is +%a, 3, 'hash - >>++ result has right number of keys';
is %a<a>, 1, 'hash - correct result from >>++';
is %a<b>, 2, 'hash - correct result from >>++';
is %a<c>, 3, 'hash - correct result from >>++';
}
#?DOES 4
{
our sub postfix:<!>($a) {
[*] 1..$a;
}
my %a = a => 1, b => 2, c => 3;
my %r = %a>>!;
is +%r, 3, 'hash - >>! result has right number of keys';
is %r<a>, 1, 'hash - correct result from >>!';
is %r<b>, 2, 'hash - correct result from >>!';
is %r<c>, 6, 'hash - correct result from >>!';
}
{
my %a = a => 1, b => 2, c => 3;
my %r = %a >>*>> 4;
is +%r, 3, 'hash - >>*>> result has right number of keys';
is %r<a>, 4, 'hash - correct result from >>*>>';
is %r<b>, 8, 'hash - correct result from >>*>>';
is %r<c>, 12, 'hash - correct result from >>*>>';
%r = 2 <<**<< %a ;
is +%r, 3, 'hash - <<**<< result has right number of keys';
is %r<a>, 2, 'hash - correct result from <<**<<';
is %r<b>, 4, 'hash - correct result from <<**<<';
is %r<c>, 8, 'hash - correct result from <<**<<';
%r = %a <<*>> 4;
is +%r, 3, 'hash - <<*>> result has right number of keys';
is %r<a>, 4, 'hash - correct result from <<*>>';
is %r<b>, 8, 'hash - correct result from <<*>>';
is %r<c>, 12, 'hash - correct result from <<*>>';
%r = 2 <<**>> %a ;
is +%r, 3, 'hash - <<**>> result has right number of keys';
is %r<a>, 2, 'hash - correct result from <<**>>';
is %r<b>, 4, 'hash - correct result from <<**>>';
is %r<c>, 8, 'hash - correct result from <<**>>';
}
{
my %a = a => 1, b => -2, c => 3;
my %r = %a>>.abs;
is +%r, 3, 'hash - >>.abs result has right number of keys';
is %r<a>, 1, 'hash - correct result from >>.abs';
is %r<b>, 2, 'hash - correct result from >>.abs';
is %r<c>, 3, 'hash - correct result from >>.abs';
}
{
my @a = (1, { a => 2, b => 3 }, 4);
my @b = <a b c>;
my @c = ('z', { a => 'y', b => 'x' }, 'w');
my @d = 'a'..'f';
my @r = @a <<~>> @b;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from <<~>>';
is @r[1]<a>, "2b", 'hash in array - correct result from <<~>>';
is @r[1]<b>, "3b", 'hash in array - correct result from <<~>>';
is @r[2], "4c", 'hash in array - correct result from <<~>>';
@r = @a >>~<< @c;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1z", 'hash in array - correct result from >>~<<';
is @r[1]<a>, "2y", 'hash in array - correct result from >>~<<';
is @r[1]<b>, "3x", 'hash in array - correct result from >>~<<';
is @r[2], "4w", 'hash in array - correct result from >>~<<';
@r = @a >>~>> @d;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from >>~>>';
is @r[1]<a>, "2b", 'hash in array - correct result from >>~>>';
is @r[1]<b>, "3b", 'hash in array - correct result from >>~>>';
is @r[2], "4c", 'hash in array - correct result from >>~>>';
@r = @d <<R~<< @a;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from <<R~<<';
is @r[1]<a>, "2b", 'hash in array - correct result from <<R~<<';
is @r[1]<b>, "3b", 'hash in array - correct result from <<R~<<';
is @r[2], "4c", 'hash in array - correct result from <<R~<<';
@r = @a <<~>> @d;
is +@r, 6, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from <<~>>';
is @r[1]<a>, "2b", 'hash in array - correct result from <<~>>';
is @r[1]<b>, "3b", 'hash in array - correct result from <<~>>';
is @r[2], "4c", 'hash in array - correct result from <<~>>';
is @r[3], "1d", 'hash in array - correct result from <<~>>';
is @r[4]<a>, "2e", 'hash in array - correct result from <<~>>';
is @r[4]<b>, "3e", 'hash in array - correct result from <<~>>';
is @r[5], "4f", 'hash in array - correct result from <<~>>';
}
{
my @a = (1, { a => 2, b => 3 }, 4);
my @b = <a b c>;
my @c = ('z', { a => 'y', b => 'x' }, 'w');
my @d = 'a'..'f';
my @r = @a «~» @b;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from «~»';
is @r[1]<a>, "2b", 'hash in array - correct result from «~»';
is @r[1]<b>, "3b", 'hash in array - correct result from «~»';
is @r[2], "4c", 'hash in array - correct result from «~»';
@r = @a »~« @c;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1z", 'hash in array - correct result from »~«';
is @r[1]<a>, "2y", 'hash in array - correct result from »~«';
is @r[1]<b>, "3x", 'hash in array - correct result from »~«';
is @r[2], "4w", 'hash in array - correct result from »~«';
@r = @a »~» @d;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from »~»';
is @r[1]<a>, "2b", 'hash in array - correct result from »~»';
is @r[1]<b>, "3b", 'hash in array - correct result from »~»';
is @r[2], "4c", 'hash in array - correct result from »~»';
@r = @d «R~« @a;
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from «R~«';
is @r[1]<a>, "2b", 'hash in array - correct result from «R~«';
is @r[1]<b>, "3b", 'hash in array - correct result from «R~«';
is @r[2], "4c", 'hash in array - correct result from «R~«';
@r = @a «~» @d;
is +@r, 6, 'hash in array - result array is the correct length';
is @r[0], "1a", 'hash in array - correct result from «~»';
is @r[1]<a>, "2b", 'hash in array - correct result from «~»';
is @r[1]<b>, "3b", 'hash in array - correct result from «~»';
is @r[2], "4c", 'hash in array - correct result from «~»';
is @r[3], "1d", 'hash in array - correct result from «~»';
is @r[4]<a>, "2e", 'hash in array - correct result from «~»';
is @r[4]<b>, "3e", 'hash in array - correct result from «~»';
is @r[5], "4f", 'hash in array - correct result from «~»';
}
{
my @a = (1, { a => 2, b => 3 }, 4);
my @r = @a.deepmap(-*);
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], -1, 'hash in array - correct result from -<<';
is @r[1]<a>, -2, 'hash in array - correct result from -<<';
is @r[1]<b>, -3, 'hash in array - correct result from -<<';
is @r[2], -4, 'hash in array - correct result from -<<';
@r = @a.deepmap(++*);
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], 2, 'hash in array - correct result from ++<<';
is @r[1]<a>, 3, 'hash in array - correct result from ++<<';
is @r[1]<b>, 4, 'hash in array - correct result from ++<<';
is @r[2], 5, 'hash in array - correct result from ++<<';
@r = @a.deepmap(*--);
is +@r, 3, 'hash in array - result array is the correct length';
is @r[0], 2, 'hash in array - correct result from ++<<';
is @r[1]<a>, 3, 'hash in array - correct result from ++<<';
is @r[1]<b>, 4, 'hash in array - correct result from ++<<';
is @r[2], 5, 'hash in array - correct result from ++<<';
is +@a, 3, 'hash in array - result array is the correct length';
is @a[0], 1, 'hash in array - correct result from ++<<';
is @a[1]<a>, 2, 'hash in array - correct result from ++<<';
is @a[1]<b>, 3, 'hash in array - correct result from ++<<';
is @a[2], 4, 'hash in array - correct result from ++<<';
}
# test non-UTF-8 input
#?niecza skip 'nonsensical test'
#?rakudo skip 'EVAL(Buf) RT #124514'
#?DOES 1
{
my $t = '(1, 2, 3) »+« (4, 3, 2)';
ok !EVAL($t.encode('ISO-8859-1')),
'Latin-1 »+« without pre-declaration is an error';
}
# Test for 'my @a = <a b c> »~» "z";' wrongly
# setting @a to [['az', 'bz', 'cz']].
{
my @a = <a b c> »~» 'z';
is "{@a[0]}, {@a[1]}, {@a[2]}", 'az, bz, cz', "dwimmy hyper doesn't return an itemized list";
}
# L<S03/"Hyper operators"/is assumed to be infinitely extensible>
# RT #122230'
{
@r = <A B C D E> »~» (1, 2, 3, *);
@e = <A1 B2 C3 D3 E3>;
is ~@r, ~@e, 'dwimmy hyper extends lists ending with * by copying the last element';
@r = <A B C D E> «~» (1, 2, 3, *);
@e = <A1 B2 C3 D3 E3>;
is ~@r, ~@e, 'dwimmy hyper extends lists ending with * by copying the last element';
@r = (1, 2, 3, *) «~« <A B C D E>;
@e = <1A 2B 3C 3D 3E>;
is ~@r, ~@e, 'dwimmy hyper extends lists ending with * by copying the last element';
@r = (1, 2, 3, *) «~» <A B C D E>;
@e = <1A 2B 3C 3D 3E>;
is ~@r, ~@e, 'dwimmy hyper extends lists ending with * by copying the last element';
@r = (1, 2, *) «~» (4, 5, *);
@e = <14 25>;
is ~@r, ~@e, 'dwimmy hyper omits * when both arguments of same length have one';
@r = (1, 2, *) «~» (4, 5, 6, *);
@e = <14 25 26>;
is ~@r, ~@e, 'dwimmy hyper takes longer length given two arguments ending with *';
}
# RT #77010
{
# niecza doesn't propagate slangs into &EVAL yet
eval-lives-ok 'sub infix:<+++>($a, $b) { ($a + $b) div 2 }; 10 >>+++<< 14', 'can use hypers with local scoped user-defined operators';
}
# RT #74530
{
is ~(-<<(1..3)), '-1 -2 -3', 'ranges and hyper ops mix';
}
# RT #77800
# Parsing hyper-subtraction
{
is ((9, 8) <<-<< (1, 2, 3, 4)), (8, 6, 6, 4), '<<-<<';
is ((9, 8, 10, 12) >>->> (1, 2)), (8, 6, 9, 10), '>>->>';
is ((9, 8) >>-<< (1, 2)), (8, 6), '>>-<<';
is ((9, 8) <<->> (1, 2, 5)), (8, 6, 4), '<<->>';
}
# RT #77876
# L<S03/Hyper operators/'@array »+=»'>
# Hyper assignment operators
{
my @array = 3, 8, 2, 9, 3, 8;
@r = @array »+=« (1, 2, 3, 4, 5, 6);
@e = 4, 10, 5, 13, 8, 14;
is @r, @e, '»+=« returns the right value';
is @array, @e, '»+=« changes its lvalue';
@array = 3, 8, 2, 9, 3, 8;
@r = @array »*=» (1, 2, 3);
@e = 3, 16, 6, 9, 6, 24;
is @r, @e, '»*=» returns the right value';
is @array, @e, '»*=» changes its lvalue';
my $a = 'apple';
my $b = 'blueberry';
my $c = 'cherry';
@r = ($a, $b, $c) »~=» <pie tart>;
@e = <applepie blueberrytart cherrypie>;
is @r, @e, '»~=» with list of scalars on the left returns the right value';
my $e = 'applepie, blueberrytart, cherrypie';
is "$a, $b, $c", $e, '»~=» changes each scalar';
}
# RT #83510
is ((1, 2) >>[+]<< (100, 200)).join(','), '101,202',
'>>[+]<< works';
# RT #77670
{
is ( { 1 + 1 }, { 2 + 2 } ).>>.(),
(2, 4),
'.>> works with .()';
is ( { 1 + 1 }, { 2 + 2 } ).>>.(),
( { 1 + 1 }, { 2 + 2 } )>>.(),
'.>>.() means the same as >>.()';
}
# RT #77668
{
sub infix:<+-*/>($a, $b) {
( { $a + $b }, { $a - $b }, { $a * $b }, { $a / $b } )>>.()
};
is 5+-*/2, (7, 3, 10, 2.5),
'can call Callable objects in a list in parallel using >>.()';
}
# RT #77114
{
#?rakudo todo "can_meta check for meta operators NYI"
eval-dies-ok 'my @a >>[=]>> (1,2,3)', "hypering assignment dies correctly";
}
# RT #123178
{
is 42 «~~« (Array, List, Parcel), (False, False, False), "hyper against an undefined Iterable doesn't hang";
is 42 «~~« (Hash, Bag, Enum), (False, False, False), "hyper against an undefined Associative doesn't hang";
}
# RT #120662
{
# <empty list> <hyper> <empty list>
is () »+« (), (), "no-dwim hyper between empty lists doesn't hang";
is () «+« (), (), "left-dwim hyper between empty lists doesn't hang";
is () »+» (), (), "right-dwim hyper between empty lists doesn't hang";
is () «+» (), (), "both-dwim hyper between empty lists doesn't hang";
# <item> <hyper> <empty list>
is True «+« (), (), "left-dwim hyper against empty RHS doesn't hang";
is True »+» (), (), "right-dwim hyper against empty RHS doesn't hang";
is True «+» (), (), "both-dwim hyper against empty RHS doesn't hang";
throws-like {True »+« ()}, X::HyperOp::NonDWIM,
left-elems => 1, right-elems => 0,
"non-dwim hyper against empty RHS dies";
# <empty list> <hyper> <item>
is () «+« True, (), "left-dwim hyper against empty LHS doesn't hang";
is () «+» True, (), "right-dwim hyper against empty LHS doesn't hang";
is () «+» True, (), "both-dwim hyper against empty LHS doesn't hang";
throws-like {() »+« True}, X::HyperOp::NonDWIM,
left-elems => 0, right-elems => 1,
"non-dwim hyper against empty RHS dies";
my @a = «"Furthermore, Subhuti," "the basic nature" "of the five" "aggregates" "is emptiness."»;
# <list> <hyper> <empty list>
is @a «+« (), (), "left-dwim hyper against empty RHS doesn't hang";
is @a »+» (), (), "right-dwim hyper against empty RHS doesn't hang";
is @a «+» (), (), "both-dwim hyper against empty RHS doesn't hang";
throws-like {@a »+« ()}, X::HyperOp::NonDWIM,
left-elems => 5, right-elems => 0,
"non-dwim hyper against empty RHS dies";
# <empty list> <hyper> <list>
is () «+« @a, (), "left-dwim hyper against empty LHS doesn't hang";
is () »+» @a, (), "right-dwim hyper against empty LHS doesn't hang";
is () «+» @a, (), "both-dwim hyper against empty LHS doesn't hang";
throws-like {() »+« @a}, X::HyperOp::NonDWIM,
left-elems => 0, right-elems => 5,
"non-dwim hyper against empty RHS dies";
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.