Skip to content
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

Closed
p6rt opened this issue Jun 17, 2010 · 6 comments
Closed

Fix &infix:<...> (separated from earlier patch) #1847

p6rt opened this issue Jun 17, 2010 · 6 comments
Labels

Comments

@p6rt
Copy link

p6rt commented Jun 17, 2010

Migrated from rt.perl.org#75832 (status was 'resolved')

Searchable as RT75832$

@p6rt
Copy link
Author

p6rt commented Jun 17, 2010

From justin.sahs@gmail.com

Fixes
#​75674​: [BUG] [TODO] Make 4 ... 0, 1, 2, 3, 4 (an infix​:<...> with a
list to the right) do the right thing in Rakudo
#​75698​: [BUG] Double zero when infix​:<...> proceeds from -5 to ^5
#​74990​: Series of letters doesn't stop at end point

Passes t/spec/S03-operators/series*.t 100% (excluding skipped test) + 1
unexpected pass

@p6rt
Copy link
Author

p6rt commented Jun 17, 2010

From justin.sahs@gmail.com

series.patch
diff --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}];
+       }
     }
 }
 

@p6rt
Copy link
Author

p6rt commented Jun 29, 2010

From @kyleha

This is an automatically generated mail to inform you that tests are now available in t/spec/S03-operators/series.t

commit bdfbb50e42841d89ba022e52de03c5661c93a59a
Author​: bbkr <bbkr@​c213334d-75ef-0310-aa23-eaa082d1ae64>
Date​: Tue Jun 29 12​:14​:47 2010 +0000

  t[t/spec] tests for RT #​75832 fudged tests that cause infinite loops because of lack of stop at wrong end point in series
 
  git-svn-id​: http://svn.pugscode.org/pugs@&#8203;31499 c213334d-75ef-0310-aa23-eaa082d1ae64

Inline Patch
diff --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';

@p6rt
Copy link
Author

p6rt commented Jun 29, 2010

The RT System itself - Status changed from 'new' to 'open'

@p6rt
Copy link
Author

p6rt commented Jul 5, 2010

From @moritz

I don't know if the patch has actually been applied, or if somebody else
fixed the problem, but the tests now pass, so I'm closing tis ticket now.

@p6rt
Copy link
Author

p6rt commented Jul 5, 2010

@moritz - Status changed from 'open' to 'resolved'

@p6rt p6rt closed this as completed Jul 5, 2010
@p6rt p6rt added the patch label Jan 5, 2020
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

1 participant