[svn:mod_parrot] r505 - in mod_parrot/trunk/languages/perl6/lib: . ModPerl6

Author: jhorwitz
Date: Sat Nov 29 07:23:29 2008
New Revision: 505

Modified:
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir
   mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm

Log:
fix completely broken call_handler and its fudged PIR friends


Modified: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir	(original)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Fudge.pir	Sat Nov 29 07:23:29 2008
@@ -19,7 +19,7 @@
     $I0 = isa $P1, 'Sub'
     if $I0 goto return_sub
   no_sub:
-    $P1 = new 'Undef'
+    $P1 = new 'Failure'
   return_sub:
     .return($P1)
 .end
@@ -32,9 +32,39 @@
     .param string name
     .param pmc args :slurpy
 
-    $P1 = 'resolve_sub'(ns, name)
-    if null $P1 goto return_result
+    $P0 = 'resolve_sub'(ns, name)
+    unless $P0 goto no_sub
     $P1 = $P0(args :flat)
+    goto return_result
+  no_sub:
+    $P1 = new 'Failure'
   return_result:
     .return($P1)
 .end
+
+# NAME: call_class_method
+# PURPOSE: call a class method
+# FUDGES: calling a class method when class is interpolated
+.sub call_class_method
+    .param string ns
+    .param string meth
+    .param pmc args :slurpy
+
+    $P0 = split '::', ns
+    $I0 = elements $P0
+    if $I0 > 1 goto nested_namespace
+    $S0 = $P0
+    $P1 = get_hll_global $S0
+    goto call_method
+  nested_namespace:
+    $S0 = pop $P0
+    $P1 = get_hll_global $P0, $S0
+  call_method:
+    if null $P1 goto no_class
+    $P0 = $P1.meth(args :flat)
+    goto return_result
+  no_class:
+    $P0 = new 'Failure'
+  return_result:
+    .return($P0)
+.end

Modified: mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	(original)
+++ mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	Sat Nov 29 07:23:29 2008
@@ -90,9 +90,8 @@
     # conventions are different for methods so just run it here
     if ($method) {
         load($class);
-	# XXX don't have subroutine interpolation, so we hardcode 'handler'
-        # XXX "split" does something to $class so it needs quotes here. hm.
-        $res = "$class".handler(|@args);
+        # XXX unfudge when namespace interpolation works
+        $res = ModPerl6::Fudge::call_class_method($class, $method, |@args);
         return $res;
     }
 
@@ -102,18 +101,19 @@
     my $subname = @names.pop;
     my $ns = join('::', @names);
 
-    # resolve_sub MUST return undef if name exists but it's not a sub
+    # XXX unfudge when namespace interpolation works
+    # resolve_sub MUST return a failure if name exists but it's not a sub
     my $sub = ModPerl6::Fudge::resolve_sub($ns, $subname);
 
-    unless ($sub) {
+    unless ($sub.defined) {
         # load $handler and try $handler::handler() (common convention)
         load($handler);
+        # XXX unfudge when namespace interpolation works
         $sub = ModPerl6::Fudge::resolve_sub($handler, 'handler');
     }
 
     # everything falls down to this block -- run the handler
-    # XXX why doesn't 'Sub' work here?
-    if ($sub) {
+    if ($sub.defined) {
         $res = $sub(|@args);
         return $res;
     }