From fddecdfea03247aa9f8804c75a641c7b9d0c8665 Mon Sep 17 00:00:00 2001
From: Stefan Seifert <nine@detonation.org>
Date: Sun, 20 Feb 2022 17:42:26 +0100
Subject: [PATCH] Give Raku code the option of returning array or arrayref

An itemized array will be returned as array reference while a non-itemized
array will get flattened into multiple return values.
---
 lib/Inline/Perl5.pm6 | 12 ++++++------
 p5helper.c           | 10 +++++++---
 t/call_back.t        | 29 +++++++++++++++++++++++++++--
 3 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/lib/Inline/Perl5.pm6 b/lib/Inline/Perl5.pm6
index 846b94d..7626d13 100644
--- a/lib/Inline/Perl5.pm6
+++ b/lib/Inline/Perl5.pm6
@@ -145,12 +145,12 @@ multi method p6_to_p5(Inline::Perl5::Array:D $value) returns Pointer {
 multi method p6_to_p5(Inline::Perl5::Exception:D $value) returns Pointer {
     self.p6_to_p5($value.payload)
 }
-multi method p6_to_p5(Positional:D $value) returns Pointer {
+multi method p6_to_p5(Positional:D \value, Bool :$retval) returns Pointer {
     my $av = $!p5.p5_newAV();
-    for @$value -> $item {
+    for value.list -> $item {
         $!p5.p5_av_push($av, self.p6_to_p5($item));
     }
-    $!p5.p5_newRV_inc($av);
+    value.VAR ~~ Scalar || !$retval ?? $!p5.p5_newRV_inc($av) !! $av
 }
 multi method p6_to_p5(IO::Handle:D $value) returns Pointer {
     my $index = $!objects.keep($value);
@@ -1253,7 +1253,7 @@ method initialize(Bool :$reinitialize) {
             }
         }
         my @args := self.p5_array_to_p6_array($args);
-        self.p6_to_p5($p6obj."$name"(|@args.grep({$_ !~~ Pair}).list, |@args.grep(Pair).hash))
+        self.p6_to_p5($p6obj."$name"(|@args.grep({$_ !~~ Pair}).list, |@args.grep(Pair).hash), :retval)
     }
     &call_method does Inline::Perl5::Caller;
 
@@ -1281,7 +1281,7 @@ method initialize(Bool :$reinitialize) {
             fail "No such symbol '$package'" unless %!loaded_modules{$package}:exists;
             $class := %!loaded_modules{$package};
         }
-        self.p6_to_p5($class."$name"(|%named<False>, |%(%named<True>)));
+        self.p6_to_p5($class."$name"(|%named<False>, |%(%named<True>)), :retval);
     }
 
     my &call_callable = sub (Int $index, Pointer $args, Pointer $err) returns Pointer {
@@ -1297,7 +1297,7 @@ method initialize(Bool :$reinitialize) {
                 return Pointer;
             }
         }
-        self.p6_to_p5($!objects.get($index)(|self.p5_array_to_p6_array($args)))
+        self.p6_to_p5($!objects.get($index)(|self.p5_array_to_p6_array($args)), :retval)
     }
 
     my &hash_at_key = sub (Int $index, Str $key) returns Pointer {
diff --git a/p5helper.c b/p5helper.c
index 5d04090..6ca9514 100644
--- a/p5helper.c
+++ b/p5helper.c
@@ -1525,8 +1525,8 @@ void return_retval(const I32 ax, SV **sp, SV *retval) {
         XSRETURN_EMPTY;
     }
     if (GIMME_V == G_ARRAY) {
-        if (SvROK(retval) && SvTYPE(SvRV(retval)) == SVt_PVAV) {
-            AV* const av = (AV*)SvRV(retval);
+        if (SvTYPE(retval) == SVt_PVAV) {
+            AV* const av = (AV*)retval;
             I32 const len = av_len(av) + 1;
             I32 i;
             for (i = 0; i < len; i++) {
@@ -1541,7 +1541,11 @@ void return_retval(const I32 ax, SV **sp, SV *retval) {
     }
     else {
         if (SvROK(retval) && SvTYPE(SvRV(retval)) == SVt_PVAV) {
-            AV* const av = (AV*)SvRV(retval);
+            XPUSHs(retval);
+            XSRETURN(1);
+        }
+        else if (SvTYPE(retval) == SVt_PVAV) {
+            AV* const av = (AV*)retval;
             XPUSHs(sv_2mortal(av_shift(av)));
             XSRETURN(1);
         }
diff --git a/t/call_back.t b/t/call_back.t
index 38237bd..8788d69 100644
--- a/t/call_back.t
+++ b/t/call_back.t
@@ -12,15 +12,40 @@ $p5.run(q/
         for (1 .. 100) {
             my @retval = $raku->test('Raku');
             is_deeply \@retval, ['Raku'];
-            my @retval = $raku->test('Raku', 42);
+            @retval = $raku->test('Raku', 42);
             is_deeply \@retval, ['Raku', 42];
+            @retval = $raku->test(['Raku', 42]);
+            is_deeply \@retval, [['Raku', 42]];
+            my $retval = $raku->test(['Raku', 42]);
+            is_deeply $retval, ['Raku', 42];
+            @retval = $raku->multi_value;
+            is_deeply \@retval, [1, 2, [3, 4]];
+            @retval = $raku->array;
+            is_deeply \@retval, [1, 2, [3, 4]];
+            $retval = $raku->array_ref;
+            is_deeply $retval, [1, 2, [3, 4]];
+            @retval = $raku->lists;
+            is_deeply \@retval, [1, 2, [3, 4]];
         }
     };
 /);
 
 class Foo {
     method test(*@args) {
-        return @args;
+        @args
+    }
+    method multi_value() {
+        1, 2, [3, 4]
+    }
+    method array() {
+        [1, 2, [3, 4]]
+    }
+    method array_ref() {
+        $[1, 2, [3, 4]]
+    }
+    method lists() is raw {
+        my @l := 1, 2, [3, 4];
+        @l
     }
 }