- Slurpy parameters now support default values

Example: func foo(*a = (1,2,3)) { say a; } foo(); # prints: [1,2,3] (default) foo(21, 42); # prints: [21, 42]
trizen · Oct 25, 2015 · 7bdfafe · 7bdfafe
1 parent eba0d72
commit 7bdfafe
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 0 deletions.
diff --git a/lib/Sidef/Deparse/Perl.pm b/lib/Sidef/Deparse/Perl.pm
@@ -181,13 +181,35 @@ HEADER
             if (exists $var->{array}) {
                 my $name = $var->{name} . refaddr($var);
                 push @{$self->{function_declarations}}, [-1, 'my @' . $name . ';'];
+
+                # Overwrite with the default values, when the array is empty
+                if (exists $var->{value}) {
+                    push @code,
+                      (   (' ' x $Sidef::SPACES) . '@'
+                        . $name . '=('
+                        . $self->deparse_expr({self => $var->{value}})
+                        . ") if not \@$name;\n");
+                }
+
                 push @code, (' ' x $Sidef::SPACES) . "\$$name = Sidef::Types::Array::Array->new(\@$name);\n";
+                $var->{in_use} ||= 1;
                 delete $var->{array};
             }
             elsif (exists $var->{hash}) {
                 my $name = $var->{name} . refaddr($var);
                 push @{$self->{function_declarations}}, [-1, 'my %' . $name . ';'];
+
+                # Overwrite with the default values, when the hash has no keys
+                if (exists $var->{value}) {
+                    push @code,
+                      (   (' ' x $Sidef::SPACES) . '%'
+                        . $name . '=('
+                        . $self->deparse_expr({self => $var->{value}})
+                        . ") if not keys \%$name;\n");
+                }
+
                 push @code, (' ' x $Sidef::SPACES) . "\$$name = Sidef::Types::Hash::Hash->new(\%$name);\n";
+                $var->{in_use} ||= 1;
                 delete $var->{hash};
             }
             elsif (exists $var->{value}) {
@@ -273,11 +295,23 @@ HEADER
             ref($var) || next;
             if (exists $var->{array}) {
                 my $name = $var->{name} . refaddr($var);
+
+                # Overwrite with the default values, when the array is empty
+                if (exists $var->{value}) {
+                    $code .= ('@' . $name . '=(' . $self->deparse_expr({self => $var->{value}}) . ") if not \@$name;\n");
+                }
+
                 $code .= (' ' x $Sidef::SPACES) . "my \$$name = Sidef::Types::Array::Array->new(\@$name);\n";
                 delete $var->{array};
             }
             elsif (exists $var->{hash}) {
                 my $name = $var->{name} . refaddr($var);
+
+                # Overwrite with the default values, when the hash has no keys
+                if (exists $var->{value}) {
+                    $code .= ('%' . $name . '=(' . $self->deparse_expr({self => $var->{value}}) . ") if not keys \%$name;\n");
+                }
+
                 $code .= (' ' x $Sidef::SPACES) . "my \$$name = Sidef::Types::Hash::Hash->new(\%$name);\n";
                 delete $var->{hash};
             }

diff --git a/scripts/Tests/default_param_values.sf b/scripts/Tests/default_param_values.sf
@@ -45,4 +45,15 @@ test3(a: 13);
 test3(13);
 
 
+#
+## Test 4 (slurpy parameters with default values)
+#
+
+func test4(*a=(1,2,3)) {
+    a;
+}
+
+assert_eq(test4(), [1,2,3]);
+assert_eq(test4(21, 42), [21, 42]);
+
 say "** Test passed!";
diff --git a/scripts/Tests/default_var_values.sf b/scripts/Tests/default_var_values.sf
@@ -29,4 +29,18 @@ assert_eq(t, 3);
 assert_eq([var x = 42], [42]);
 assert_eq(x, 42);
 
+# Default values or provided values
+var (*v1 = (1,2,3))          = (21, 42);
+var (:h1 = (a => 1, b => 2)) = (a => 42);
+
+assert_eq(v1, [21, 42]);
+assert_eq(h1, :(a => 42));
+
+# Default values only
+var (*v2 = (1,2,3));
+var (:h2 = (a => 1, b => 2));
+
+assert_eq(v2, [1,2,3]);
+assert_eq(h2, :(a => 1, b => 2));
+
 say "** Test passed!";