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

[email protected] Thu, 27 Nov 2008 16:40:51 -0800 (PST)
Newsgroups perl.cvs.mod_parrot
Message-ID <[email protected]>
Author: jhorwitz
Date: Thu Nov 27 16:40:50 2008
New Revision: 504

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

Log:
fix null pmc errors in call_handler


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	Thu Nov 27 16:40:50 2008
@@ -14,7 +14,11 @@
     $P0 = split '::', ns
     $P1 = get_hll_global $P0, name
     $I0 = isnull $P1
-    unless $I0 goto return_sub
+    if $I0 goto no_sub
+  isa_sub:
+    $I0 = isa $P1, 'Sub'
+    if $I0 goto return_sub
+  no_sub:
     $P1 = new 'Undef'
   return_sub:
     .return($P1)

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	Thu Nov 27 16:40:50 2008
@@ -78,6 +78,7 @@
 sub call_handler($ctx, $handler, *@args)
 {
     my $sub;
+    my $res;
 
     # resolve a method handler
     # XXX fix when array lvalues work
@@ -91,7 +92,7 @@
         load($class);
 	# XXX don't have subroutine interpolation, so we hardcode 'handler'
         # XXX "split" does something to $class so it needs quotes here. hm.
-        my $res = "$class".handler(|@args);
+        $res = "$class".handler(|@args);
         return $res;
     }
 
@@ -100,23 +101,29 @@
     my @names = split('::', $handler);
     my $subname = @names.pop;
     my $ns = join('::', @names);
+
+    # resolve_sub MUST return undef if name exists but it's not a sub
     my $sub = ModPerl6::Fudge::resolve_sub($ns, $subname);
-    unless ($sub.isa('Block')) {
+
+    unless ($sub) {
         # load $handler and try $handler::handler() (common convention)
         load($handler);
         $sub = ModPerl6::Fudge::resolve_sub($handler, 'handler');
     }
 
-    # run the handler
+    # everything falls down to this block -- run the handler
     # XXX why doesn't 'Sub' work here?
-    if ($sub.isa('Block')) {
-        my $res = $sub(|@args);
+    if ($sub) {
+        $res = $sub(|@args);
         return $res;
     }
+    else { 
+        # nothing worked -- return an error
+        # XXX should also log something here
+        $res = $Apache::Const::HTTP_INTERNAL_SERVER_ERROR;
+    }
 
-    # nothing worked -- return an error
-    # XXX should also log something here
-    return $Apache::Const::HTTP_INTERNAL_SERVER_ERROR
+    return $Apache::Const::HTTP_INTERNAL_SERVER_ERROR;
 }
     
 sub response_handler($ctx)