Fix bug with .push not creating copies of pushed values. Fixes RT #69…

…548.
rakudo · Oct 18, 2009 · 827734a · 827734a
1 parent 24ebf39
commit 827734a
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 9 deletions.
diff --git a/src/classes/Array.pir b/src/classes/Array.pir
@@ -116,19 +116,21 @@ Add C<args> to the end of the Array.
     .local pmc type, it
     type = self.'of'()
     args.'!flatten'()
-    it = iter args
+    $I1 = elements args
+    $I0 = 0
   it_loop:
-    unless it goto it_loop_end
-    $P0 = shift it
-    $I0 = type.'ACCEPTS'($P0)
-    unless $I0 goto type_error
+    if $I0 >= $I1 goto it_loop_end
+    $P0 = new ['Perl6Scalar']
+    setprop $P0, 'type', type
+    $P1 = args[$I0]
+    $P0.'!STORE'($P1, 'Push')
+    args[$I0] = $P0
+    inc $I0
     goto it_loop
   it_loop_end:
     $I0 = elements self
     splice self, args, $I0, 0
     .return (self)
-  type_error:
-    'die'('Type check failure in push')
 .end
 .sub '' :init :load
     .local pmc block, signature

diff --git a/src/classes/Object.pir b/src/classes/Object.pir
@@ -560,6 +560,8 @@ in the future.)
 
 .sub '!STORE' :method :subid('Object::!STORE')
     .param pmc source
+    .param string typeerr      :optional
+    .param int has_typeerr     :opt_flag
     source = '!CALLMETHOD'('Scalar', source)
     $I0 = defined source
     unless $I0 goto do_store
@@ -579,7 +581,10 @@ in the future.)
     .return (self)
 
   err_type:
-    $S0 = '!make_type_fail_message'('Assignment', source, type)
+    if has_typeerr goto have_typeerr
+    typeerr = 'Assignment'
+  have_typeerr:
+    $S0 = '!make_type_fail_message'(typeerr, source, type)
     'die'($S0)
 .end
 

diff --git a/src/setting/Any-list.pm b/src/setting/Any-list.pm
@@ -29,7 +29,17 @@ class Any is also {
             my $arity = &expr.arity || 1;
             my @args;
             for @.list {
-                @args.push($_);
+                ## We have to use PIR's 'push' here, because map can
+                ## mutate the elements of the list, and @args.push()
+                ## results in @args getting copies of the elements.
+                ## This may all get fixed when we come up with a way
+                ## to do partial bindings and not have to check .arity
+                ## or .count .
+                Q:PIR {
+                    $P0 = find_lex '@args'
+                    $P1 = find_lex '$_'
+                    push $P0, $P1
+                };
                 if (@args == $arity) {
                     take &expr(|@args);
                     @args = ();