Perlito5 - js - fix subroutine reference

fglock · Aug 7, 2013 · f8bc871 · f8bc871
1 parent c2c07f3
commit f8bc871
Show file tree

Hide file tree

Showing 5 changed files with 131 additions and 21 deletions.
diff --git a/html/perlito5.js b/html/perlito5.js
diff --git a/perlito5.pl b/perlito5.pl
diff --git a/src5/lib/Perlito5/Javascript2/Emitter.pm b/src5/lib/Perlito5/Javascript2/Emitter.pm
@@ -1231,7 +1231,14 @@ package Perlito5::AST::Call;
         if  ($meth eq 'postcircumfix:<( )>')  {
 
             my $invocant;
-            if (  ref( $self->{invocant} ) eq 'Perlito5::AST::Var' 
+            if (  ref( $self->{invocant} ) eq 'Perlito5::AST::Apply' 
+               && $self->{invocant}{code} eq 'prefix:<&>'
+               )
+            {
+                my $arg   = $self->{invocant}{arguments}->[0];
+                $invocant = 'p5code_lookup_by_name("' . $Perlito5::PKG_NAME . '", ' . $arg->emit_javascript2($level) . ')';
+            }
+            elsif (  ref( $self->{invocant} ) eq 'Perlito5::AST::Var' 
                && $self->{invocant}{sigil} eq '&'
                )
             {
@@ -1493,7 +1500,7 @@ package Perlito5::AST::Apply;
             my $self  = $_[0];
             my $level = $_[1];
             my $arg   = $self->{arguments}->[0];
-            'p5code_lookup_by_name("' . $Perlito5::PKG_NAME . '", ' . $arg->emit_javascript2($level) . ')';
+            'p5code_lookup_by_name("' . $Perlito5::PKG_NAME . '", ' . $arg->emit_javascript2($level) . ')([])';
         },
         'circumfix:<[ ]>' => sub {
             my $self = $_[0];
@@ -1852,7 +1859,25 @@ package Perlito5::AST::Apply;
             my $self      = shift;
             my $level     = shift;
             my $wantarray = shift;
-            '('  . join(' ', map( $_->emit_javascript2( $level ), @{$self->{arguments}} ))    . ' != null)' 
+            my $arg = $self->{arguments}[0];
+            my $invocant;
+            if (  ref( $arg ) eq 'Perlito5::AST::Apply' 
+               && $arg->{code} eq 'prefix:<&>'
+               )
+            {
+                my $arg2   = $arg->{arguments}->[0];
+                $invocant = 'p5code_lookup_by_name("' . $Perlito5::PKG_NAME . '", ' . $arg2->emit_javascript2($level) . ')';
+            }
+            elsif (  ref( $arg ) eq 'Perlito5::AST::Var' 
+               && $arg->{sigil} eq '&'
+               )
+            {
+                $invocant = 'p5pkg["' . ($arg->{namespace} || $Perlito5::PKG_NAME) . '"]["' . $arg->{name} . '"]';
+            }
+            else {
+                $invocant = $arg->emit_javascript2($level, 'scalar');
+            }
+            '(' . $invocant . ' != null)' 
         },
 
         'shift' => sub {

diff --git a/src5/lib/Perlito5/Javascript2/Runtime.pm b/src5/lib/Perlito5/Javascript2/Runtime.pm
@@ -134,6 +134,10 @@ function p5make_package(pkg_name) {
 }
 
 function p5code_lookup_by_name(package_name, sub_name) {
+    // sub_name can be a function already
+    if (typeof sub_name === "function") {
+        return sub_name;
+    }
     // sub_name can have an optional namespace
     var parts = sub_name.split(/::/);
     if (parts.length > 1) {

diff --git a/t5/01-perlito/410-ampersand.t b/t5/01-perlito/410-ampersand.t
@@ -1,7 +1,7 @@
 use feature 'say';
 use strict;
 
-say "1..15";
+say "1..21";
 
 my $v = 0;
 my $r = 0;
@@ -96,3 +96,35 @@ print "not " if $r != 0;
 print "ok 15 - with_proto $r\n";
 
 
+# ampersand reference
+
+$v = 3;
+$r = \&with_proto;
+$r = &$r(4);
+print "not " if $v != 7;
+print "ok 16 - with_proto $v\n";
+print "not " if $r != 7;
+print "ok 17 - with_proto $r\n";
+
+# ampersand reference, no parenthesis
+
+$v = 3;
+$r = \&with_proto;
+$r = &$r;
+print "not " if $v != 11;
+print "ok 18 - with_proto $v\n";
+print "not " if $r != 11;
+print "ok 19 - with_proto $r\n";
+
+
+# ampersand reference, call with arrow
+
+$v = 3;
+$r = \&with_proto;
+$r = $r->(4);
+print "not " if $v != 7;
+print "ok 20 - with_proto $v\n";
+print "not " if $r != 7;
+print "ok 21 - with_proto $r\n";
+
+