Get $x.Foo::bar method syntax working again, minus a bug the version …

…in alpha had.
rakudo · Mar 13, 2010 · 04102ca · 04102ca
1 parent 8edd6c9
commit 04102ca
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 4 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1565,6 +1565,9 @@ method dotty:sym<.>($/) { make $<dottyop>.ast; }
 
 method dotty:sym<.*>($/) {
     my $past := $<dottyop>.ast;
+    unless $past.isa(PAST::Op) && $past.pasttype() eq 'callmethod' {
+        $/.CURSOR.panic("Can not use " ~ $<sym>.Str ~ " on a non-identifier method call");
+    }
     $past.unshift($past.name);
     $past.name('!dispatch_' ~ $<sym>.Str);
     $past.pasttype('call');
@@ -1592,13 +1595,28 @@ method privop($/) {
 
 method methodop($/) {
     my $past := $<args> ?? $<args>[0].ast !! PAST::Op.new( :node($/) );
-    if $<identifier> {
-        $past.name( ~$<identifier> );
+    $past.pasttype('callmethod');
+    if $<longname> {
+        # May just be .foo, but could also be .Foo::bar
+        my @parts := Perl6::Grammar::parse_name(~$<longname>);
+        my $name := @parts.pop;
+        if +@parts {
+            $past.unshift(PAST::Var.new(
+                :name(@parts.pop),
+                :namespace(@parts),
+                :scope('package')
+            ));
+            $past.unshift($name);
+            $past.name('!dispatch_::');
+            $past.pasttype('call');
+        }
+        else {
+            $past.name( $name );
+        }
     }
     elsif $<quote> {
         $past.name( $<quote>.ast );
     }
-    $past.pasttype('callmethod');
     make $past;
 }
 

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1092,7 +1092,7 @@ token privop {
 
 token methodop {
     [
-    | <identifier>
+    | <longname>
     | <?before <[ ' " ]> >
         <quote>
         [ <?before '(' | '.(' | '\\'> || <.panic: "Quoted method name requires parenthesized arguments"> ]

diff --git a/src/glue/dispatch.pir b/src/glue/dispatch.pir
@@ -258,6 +258,33 @@ there are none.
 .end
 
 
+=item !dispatch_::
+
+Helper for handling calls of the form .Foo::bar.
+
+=cut
+
+.sub '!dispatch_::'
+    .param pmc invocant
+    .param string name
+    .param pmc target
+    .param pmc pos_args   :slurpy
+    .param pmc named_args :slurpy :named
+    $I0 = target.'ACCEPTS'(invocant)
+    unless $I0 goto not_allowed
+    $P0 = find_method target, name
+    .tailcall $P0(invocant, pos_args :flat, named_args :flat :named)
+  not_allowed:
+    $S0 = "Can not call method '"
+    concat $S0, name
+    concat $S0, "' on unrelated type '"
+    $S1 = target.'perl'()
+    concat $S0, $S1
+    concat $S0, "'"
+    '&die'($S0)
+.end
+
+
 =item !deferal_fail
 
 Used by P6invocation to help us get soft-failure semantics when no deferal