New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Fix &infix:<...> (separated from earlier patch) #1847
Comments
From justin.sahs@gmail.comFixes Passes t/spec/S03-operators/series*.t 100% (excluding skipped test) + 1 |
From justin.sahs@gmail.comseries.patchdiff --git a/src/core/operators.pm b/src/core/operators.pm
index 7e02233..c2218a7 100644
--- a/src/core/operators.pm
+++ b/src/core/operators.pm
@@ -306,9 +306,19 @@ our multi sub item($item) {
class Whatever { ... }
-# the magic one that handles stuff like
-# 'a' ... 'z' and 'z' ... 'a'
-our multi sub infix:<...>($lhs, $rhs) {
+our multi sub infix:<scmp>($lhs, $rhs) {
+ $lhs cmp $rhs;
+}
+
+our multi sub infix:<scmp>(Str $lhs, Str $rhs) {
+ $lhs.chars <=> $rhs.chars || $lhs cmp $rhs;
+}
+
+our multi sub infix:<scmp>($lhs, @rhs) {
+ $lhs scmp @rhs[0];
+}
+
+our multi sub infix:<...>($lhs is copy, $rhs) {
if $rhs ~~ Whatever {
my $i = $lhs;
return gather {
@@ -321,35 +331,36 @@ our multi sub infix:<...>($lhs, $rhs) {
gather {
take $lhs;
- if ($lhs cmp $rhs) == 1 {
+ if ($lhs scmp $rhs) == 1 {
my $x = $lhs;
# since my $a = 'a'; $a-- gives
# "Decrement out of range" we can't easily
# decrement over our target, which is why the
# case of going backwards is slighly more complicated
# than going forward
- while (--$x cmp $rhs) == 1 {
+ while (--$x scmp $rhs) == 1 {
# need to make a fresh copy here because of RT #62178
my $y = $x;
take $y;
}
- take $x if ($x cmp $rhs) == 0;
- } elsif ($lhs cmp $rhs) == -1 {
+ take $x if ($x scmp $rhs) == 0;
+ } elsif ($lhs scmp $rhs) == -1 {
my $x = $lhs;
- while (++$x cmp $rhs) <= 0 {
+ while (++$x scmp $rhs) <= 0 {
my $y = $x;
take $y;
}
}
-
if $rhs ~~ Iterable {
- for @($rhs) {
- take $_;
- }
- }
+ # the first element has already been taken
+ # should be:
+ # take $_ for $rhs[1..*]; but this doesn't work yet
+ take $_ for $rhs[{1..$_-1}];
+ }
}
}
+
# our multi sub infix:<...>($lhs, Code $rhs) {
# if $rhs.count != 1 {
# die "Series operator currently cannot handle blocks with count != 1";
@@ -368,24 +379,6 @@ our multi sub infix:<...>($lhs, $rhs) {
# }
# }
# }
-#
-# our multi sub infix:<...>(@lhs, Whatever) {
-# given @lhs.elems {
-# when 2 {
-# @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
-# }
-# when 3 {
-# if @lhs[1] - @lhs[0] == @lhs[2] - @lhs[1] {
-# @lhs[0] ... { $_ + (@lhs[1] - @lhs[0]) };
-# } elsif @lhs[1] / @lhs[0] == @lhs[2] / @lhs[1] {
-# @lhs[0] ... { $_ * (@lhs[1] / @lhs[0]) };
-# } else {
-# fail "Unable to figure out pattern of series";
-# }
-# }
-# default { fail "Unable to figure out pattern of series"; }
-# }
-# }
our multi sub infix:<...>(Code $lhs, $rhs) {
my $limit;
@@ -407,17 +400,17 @@ our multi sub infix:<...>(Code $lhs, $rhs) {
our multi sub infix:<...>(@lhs is copy, $rhs) {
my sub succ-or-pred($lhs, $rhs) {
if $rhs ~~ Whatever || $lhs cmp $rhs != 1 {
- -> $x { $x.succ };
+ -> $x {$x.succ};
} else {
- -> $x { $x.pred };
+ -> $x {$x.pred};
}
}
my sub succ-or-pred2($lhs0, $lhs1, $rhs) {
if $lhs1 cmp $lhs0 == 0 {
- $next = { $_ };
+ return { $_ };
} else {
- $next = succ-or-pred($lhs1, $rhs);
+ return succ-or-pred($lhs1, $rhs);
}
}
@@ -436,7 +429,7 @@ our multi sub infix:<...>(@lhs is copy, $rhs) {
when 2 {
my $diff = @lhs[1] - @lhs[0];
if $diff == 0 {
- $next = succ-or-pred2(@lhs[0], @lhs[1], $rhs)
+ $next = succ-or-pred2(@lhs[0], @lhs[1], $rhs);
} else {
$next = { $_ + $diff };
}
@@ -487,6 +480,13 @@ our multi sub infix:<...>(@lhs is copy, $rhs) {
}
}
}
+
+ if $rhs ~~ Iterable {
+ # the first element has already been taken
+ # should be:
+ # take $_ for $rhs[1..*]; but this doesn't work yet
+ take $_ for $rhs[{1..$_-1}];
+ }
}
}
|
From @kylehaThis is an automatically generated mail to inform you that tests are now available in t/spec/S03-operators/series.t commit bdfbb50e42841d89ba022e52de03c5661c93a59a t[t/spec] tests for RT #75832 fudged tests that cause infinite loops because of lack of stop at wrong end point in series Inline Patchdiff --git a/t/spec/S03-operators/series.t b/t/spec/S03-operators/series.t
index 0e09041..8b18c8e 100644
--- a/t/spec/S03-operators/series.t
+++ b/t/spec/S03-operators/series.t
@@ -106,6 +106,7 @@ is (1, { 1 / ((1 / $_) + 1) } ... 0).[^5].map({.perl}).join(', '), '1, 1/2, 1/3,
# empty series
# L<S03/List infix precedence/'limit value is on the "wrong"'>
+#?rakudo 5 skip "RT #75832, series does not stop at end point"
is (1, 2 ... 0), Nil, 'empty increasing arithmetic series';
is (1, 0 ... 2), Nil, 'empty decreasing arithmetic series';
is (1, 2, 4 ... -5), Nil, 'empty increasing geometric series'; |
The RT System itself - Status changed from 'new' to 'open' |
From @moritzI don't know if the patch has actually been applied, or if somebody else |
@moritz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#75832 (status was 'resolved')
Searchable as RT75832$
The text was updated successfully, but these errors were encountered: