- Fixed the deparsing of the prefix-colon operator. (fixes #84)

Thanks to Cat Stevens (@catb0t) for finding and reporting this issue.
trizen · Mar 8, 2019 · 9244cf4 · 9244cf4
1 parent 3766edf
commit 9244cf4
Show file tree

Hide file tree

Showing 5 changed files with 67 additions and 10 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -865,6 +865,7 @@ scripts/Tests/pipeline_zip_operator.sf
 scripts/Tests/polynomial_regression.sf
 scripts/Tests/postfix_exclamation_mark.sf
 scripts/Tests/power_numbers.sf
+scripts/Tests/prefix_colon_hash.sf
 scripts/Tests/prefix_methods.sf
 scripts/Tests/prefix_unary_operators.sf
 scripts/Tests/problem_of_apollonius.sf

diff --git a/lib/Sidef/Deparse/Perl.pm b/lib/Sidef/Deparse/Perl.pm
@@ -77,6 +77,8 @@ package Sidef::Deparse::Perl {
                   Sidef::DataTypes::Object::LazyMethod    Sidef::Object::LazyMethod
                   Sidef::DataTypes::Object::Enumerator    Sidef::Object::Enumerator
 
+                  Sidef::Meta::PrefixColon                Sidef::Types::Hash::Hash
+
                   Sidef::Sys::Sig                         Sidef::Sys::Sig
                   Sidef::Sys::Sys                         Sidef::Sys::Sys
                   Sidef::Perl::Perl                       Sidef::Perl::Perl
@@ -777,14 +779,18 @@ HEADER
                     $] < 5.025002 && $self->top_add(q{use feature 'lexical_subs'; no warnings 'experimental::lexical_subs';});
 
                     # XXX: this is known to cause segmentation faults in perl-5.18.* and perl-5.20.* when used in a class
-                    $code = "my sub $name(){state\$_$refaddr"
-                      . (defined($obj->{expr}) ? ('=do{' . $self->deparse_script($obj->{expr}) . '}') : '') . "}; ($name)";
+                    $code =
+                        "my sub $name(){state\$_$refaddr"
+                      . (defined($obj->{expr}) ? ('=do{' . $self->deparse_script($obj->{expr}) . '}') : '')
+                      . "}; ($name)";
                 }
 
                 # Otherwise, use static constants
                 else {
-                    $code = "sub $name(){state\$_$refaddr"
-                      . (defined($obj->{expr}) ? ('=do{' . $self->deparse_script($obj->{expr}) . '}') : '') . "}; ($name)";
+                    $code =
+                        "sub $name(){state\$_$refaddr"
+                      . (defined($obj->{expr}) ? ('=do{' . $self->deparse_script($obj->{expr}) . '}') : '')
+                      . "}; ($name)";
                 }
             }
             else {
@@ -1525,11 +1531,11 @@ HEADER
 
                 # Optimization for hashes
                 if (
-                        $ref eq 'Sidef::DataTypes::Hash::Hash'
-                    and $i == 0
-                    and (   $method eq 'call'
-                         or $method eq 'new'
-                         or $method eq ':')
+                    (
+                     $ref eq 'Sidef::DataTypes::Hash::Hash' and $i == 0 and (   $method eq 'call'
+                                                                             or $method eq 'new')
+                    )
+                    or ($ref eq 'Sidef::Meta::PrefixColon' and $method eq ':')
                   ) {
                     $code = 'bless({' . $self->deparse_args(@{$call->{arg}}) . "}, '$self->{data_types}{$ref}')";
                     next;

diff --git a/lib/Sidef/Deparse/Sidef.pm b/lib/Sidef/Deparse/Sidef.pm
@@ -614,6 +614,11 @@ package Sidef::Deparse::Sidef {
 
                 if (defined $method) {
 
+                    if ($i == 0 and $ref eq 'Sidef::Meta::PrefixColon' and $method eq ':') {
+                        $code = ':' . $self->deparse_args(@{$call->{arg}});
+                        next;
+                    }
+
                     if (ref($method) ne '') {
                         $code .= '->'
                           . (

diff --git a/lib/Sidef/Parser.pm b/lib/Sidef/Parser.pm
@@ -142,7 +142,7 @@ package Sidef::Parser {
                       | print
                       | defined
                     )\b)                                     (?{ state $x = bless({}, 'Sidef::Operator::Unary') })
-                | :                                          (?{ state $x = bless({}, 'Sidef::DataTypes::Hash::Hash') })
+                | :                                          (?{ state $x = bless({}, 'Sidef::Meta::PrefixColon') })
               )
             }x,
             quote_operators_re => qr{\G

diff --git a/scripts/Tests/prefix_colon_hash.sf b/scripts/Tests/prefix_colon_hash.sf
@@ -0,0 +1,45 @@
+#!/usr/bin/ruby
+
+# Test the prefix-colon operator `:(...)`.
+# https://github.com/trizen/sidef/issues/84
+
+class X {
+  has Hash colon_inner = Hash(
+    :prop => :(:k => :v)
+  )
+
+  has Hash colon_outer = :(
+    :prop => Hash(:k => :v)
+  )
+
+  has Hash colon_both = :(
+    :prop => :(:k, :v)
+  )
+
+  has Hash colon_none = Hash(
+    :prop => Hash(:k, :v)
+  )
+}
+
+func g {
+  var Hash y = :(:k, :())
+  return y
+}
+
+var x = X()
+
+var expect = Hash("prop" => Hash("k" => "v"))
+
+assert_eq(x.colon_inner, expect)
+assert_eq(x.colon_outer, expect)
+assert_eq(x.colon_both, expect)
+assert_eq(x.colon_none, expect)
+
+var Hash h = :(:k => :())
+
+assert_eq(h, Hash("k" => Hash()))
+assert_eq(g(), Hash("k" => Hash()))
+
+assert_eq(x.colon_outer\{:prop}, Hash("k" => "v"))
+
+say "** Test passed!"