# New Ticket Created by Prakash Kailasa
# Please include the string: [perl #75246]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=75246 >
Please review the patch attached which lets hyper operators be used on
nested arrays like (1, 2, [3, 4]).
>> perl6 -e 'my @r = (1, 2, [3, 4]) >>+<< (4, 5, [6, 7]); say @r.perl'
[5, 7, [9, 11]]
>> perl6 -e 'my @r = (1, 2, [3, 4]); @r>>++; say @r.perl'
[2, 3, [4, 5]]
More tests were added to properly compare the nested arrays (not just
comparing the stringified arrays).
Patched files:
src/core/metaops.pm
t/spec/S03-metaops/hyper.t
Thanks,
Prakash Kailasa
diff --git a/src/core/metaops.pm b/src/core/metaops.pm
index 7dbd1ef..dfc83c3 100644
--- a/src/core/metaops.pm
+++ b/src/core/metaops.pm
@@ -88,7 +88,11 @@ our multi sub hyper(&op, Iterable $lhs-iterable, Iterable $rhs-iterable, :$dwim-
my @result;
for @lhs Z @rhs -> $l, $r {
- @result.push(op($l, $r));
+ if $l ~~ Iterable || $r ~~ Iterable {
+ @result.push([hyper(&op, $l.list, $r.list, :$dwim-left, :$dwim-right)]);
+ } else {
+ @result.push(op($l, $r));
+ }
}
@result
}
@@ -100,7 +104,19 @@ our multi sub hyper(&op, $lhs, $rhs, :$dwim-left, :$dwim-right) {
our multi sub hyper(&op, @arg) {
my @result;
for @arg {
- @result.push(op($_));
+
+ # this should work, but isn't :(
+
+ # if $_ ~~ Iterable {
+ # @result.push([hyper(&op, $_)]);
+ # } else {
+ # @result.push(op($_));
+ # }
+
+ # this is terribly ugly; but works
+
+ @result.push([hyper(&op, $_)]) if $_ ~~ Iterable;
+ @result.push(op($_)) if $_ !~~ Iterable;
}
@result
}
Index: t/spec/S03-metaops/hyper.t
===================================================================
--- t/spec/S03-metaops/hyper.t (revision 30688)
+++ t/spec/S03-metaops/hyper.t (working copy)
@@ -76,13 +76,13 @@
{ # unary postfix
my @r = (1, 2, 3);
- try { @r»++ };
+ @r»++;
my @e = (2, 3, 4);
#?pugs todo
is(~...@r, ~...@e, "hyper auto increment an array");
@r = (1, 2, 3);
- try { @r>>++ };
+ @r>>++;
@e = (2, 3, 4);
#?pugs todo
is(~...@r, ~...@e, "hyper auto increment an array ASCII notation");
@@ -223,66 +223,76 @@
is(~...@r, ~...@e, "hyper-method-call on list of user-defined objects");
};
-#?rakudo skip 'unicode'
+#?rakudo todo 'unicode'
{ # 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");
@r = -<< ([1, 2], [3, [4, 5]]);
@e = ([-1, -2], [-3, [-4, -5]]);
is(~...@r, ~...@e, "distribution for unary prefix, ASCII");
+ is_deeply(@r, @e, "distribution for unary prefix, ASCII, deep comparison");
};
-#?rakudo skip 'unicode'
+#?rakudo todo 'unicode'
{ # distribution for unary postfix autoincrement
my @r;
@r = ([1, 2], [3, [4, 5]]);
- try { @r»++ };
+ @r»++;
my @e = ([2, 3], [4, [5, 6]]);
#?pugs todo
is(~...@r, ~...@e, "distribution for unary postfix autoincr");
+ is_deeply(@r, @e, "distribution for unary postfix autoincr, deep comparison");
@r = ([1, 2], [3, [4, 5]]);
- try { @r>>++ };
+ @r>>++;
@e = ([2, 3], [4, [5, 6]]);
#?pugs todo
is(~...@r, ~...@e, "distribution for unary postfix autoincr, ASCII");
+ is_deeply(@r, @e, "distribution for unary postfix autoincr, ASCII, deep comparison");
};
#?DOES 3
-#?rakudo skip 'non-unicode hypers'
+#?rakudo todo 'non-unicode hypers'
{ # 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 comparision");
@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
-#?rakudo skip 'unicode hypers'
+#?rakudo todo 'unicode hypers'
{ # 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);
+ @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]);
+ @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
@@ -338,7 +348,7 @@
ok ?(@a »|« @b), '»|« hyperjunction evals';
ok ?(@a >>|<< @b), '>>|<< hyperjunction evals, ASCII';
ok ?(@a »&« @b), '»&« hyperjunction evals';
- ok ?(@a >>&<< @b), '»&« hyperjunction evals, ASCII';
+ ok ?(@a >>&<< @b), '>>&<< hyperjunction evals, ASCII';
}
# test hypers on hashes
