Make sure we don't lose scalarness of [...] and so forth that are ret…

…urned, just rw-ness should be stripped.
rakudo · Jul 9, 2011 · f2e0b4a · f2e0b4a
1 parent fd88893
commit f2e0b4a
Show file tree

Hide file tree

Showing 3 changed files with 24 additions and 2 deletions.
diff --git a/src/binder/container.c b/src/binder/container.c
@@ -110,6 +110,16 @@ void Rakudo_cont_store(PARROT_INTERP, PMC *cont, PMC *value,
     }
 }
 
+/* Checks if the thing we have is a rw scalar. */
+INTVAL Rakudo_cont_is_rw_scalar(PARROT_INTERP, PMC *check) {
+    if (STABLE(check)->WHAT == scalar_type) {
+        Rakudo_Scalar *scalar = (Rakudo_Scalar *)PMC_data(check);
+        if (!PMC_IS_NULL(scalar->descriptor))
+            return ((Rakudo_ContainerDescriptor *)PMC_data(scalar->descriptor))->rw;
+    }
+    return 0;
+}
+
 /* Creates a new Scalar container with the associated container
  * descriptor. */
 PMC * Rakudo_cont_scalar_from_descriptor(PARROT_INTERP, PMC *descriptor) {
@@ -118,3 +128,12 @@ PMC * Rakudo_cont_scalar_from_descriptor(PARROT_INTERP, PMC *descriptor) {
     PARROT_GC_WRITE_BARRIER(interp, new_scalar);
     return new_scalar;
 }
+
+/* Creates a new Scalar container with the associated container
+ * descriptor. */
+PMC * Rakudo_cont_scalar_with_value_no_descriptor(PARROT_INTERP, PMC *value) {
+    PMC *new_scalar = REPR(scalar_type)->instance_of(interp, scalar_type);
+    ((Rakudo_Scalar *)PMC_data(new_scalar))->value = value;
+    PARROT_GC_WRITE_BARRIER(interp, new_scalar);
+    return new_scalar;
+}
diff --git a/src/binder/container.h b/src/binder/container.h
@@ -23,3 +23,5 @@ void Rakudo_cont_set_scalar_type(PMC *type);
 PMC * Rakudo_cont_decontainerize(PARROT_INTERP, PMC *var);
 void Rakudo_cont_store(PARROT_INTERP, PMC *cont, PMC *value, INTVAL type_check, INTVAL rw_check);
 PMC * Rakudo_cont_scalar_from_descriptor(PARROT_INTERP, PMC *container_descriptor);
+PMC * Rakudo_cont_scalar_with_value_no_descriptor(PARROT_INTERP, PMC *value);
+INTVAL Rakudo_cont_is_rw_scalar(PARROT_INTERP, PMC *check);
diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops
@@ -673,14 +673,15 @@ If the sub is not rw, decontainerizes the return value.
 
 */
 inline op perl6_decontainerize_return_value(out PMC, in PMC) :base_core {
-    if ($2->vtable->base_type == smo_id) {
+    if ($2->vtable->base_type == smo_id && Rakudo_cont_is_rw_scalar(interp, $2)) {
         PMC *cur_ctx     = CURRENT_CONTEXT(interp);
         PMC *parrot_sub  = Parrot_pcc_get_sub(interp, cur_ctx);
         PMC *p6sub;
         Rakudo_Code *code;
         GETATTR_Sub_multi_signature(interp, parrot_sub, p6sub);
         code = (Rakudo_Code *)PMC_data(p6sub);
-        $1 = code->rw ? $2 : Rakudo_cont_decontainerize(interp, $2);
+        $1 = code->rw ? $2 : Rakudo_cont_scalar_with_value_no_descriptor(interp, 
+            Rakudo_cont_decontainerize(interp, $2));
     }
     else {
         $1 = $2;