[Bast-commits] r3554 - in trunk/Devel-Declare: . lib/Devel t

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-07-01 19:42:26 +0100 (Sun, 01 Jul 2007)
New Revision: 3554

Added:
   trunk/Devel-Declare/t/pack.t
Modified:
   trunk/Devel-Declare/Declare.xs
   trunk/Devel-Declare/lib/Devel/Declare.pm
Log:
package handling

Modified: trunk/Devel-Declare/Declare.xs
===================================================================
--- trunk/Devel-Declare/Declare.xs	2007-07-01 16:58:39 UTC (rev 3553)
+++ trunk/Devel-Declare/Declare.xs	2007-07-01 18:42:26 UTC (rev 3554)
@@ -15,6 +15,7 @@
 
 #define DD_HANDLE_NAME 1
 #define DD_HANDLE_PROTO 2
+#define DD_HANDLE_PACKAGE 8
 
 #ifdef DD_DEBUG
 #define DD_DEBUG_S printf("Buffer: %s\n", s);
@@ -135,9 +136,9 @@
 
     DD_DEBUG_S
 
-    /* 0 in arg 4 is allow_package - not trying that yet :) */
+    /* arg 4 is allow_package */
 
-    s = scan_word(s, tmpbuf, sizeof tmpbuf, 0, &len);
+    s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len);
 
     DD_DEBUG_S
 

Modified: trunk/Devel-Declare/lib/Devel/Declare.pm
===================================================================
--- trunk/Devel-Declare/lib/Devel/Declare.pm	2007-07-01 16:58:39 UTC (rev 3553)
+++ trunk/Devel-Declare/lib/Devel/Declare.pm	2007-07-01 18:42:26 UTC (rev 3554)
@@ -11,8 +11,9 @@
 use constant DECLARE_NAME => 1;
 use constant DECLARE_PROTO => 2;
 use constant DECLARE_NONE => 4;
+use constant DECLARE_PACKAGE => 8+1; # name implicit
 
-use vars qw(%declarators %declarator_handlers @next_pad_inject);
+use vars qw(%declarators %declarator_handlers);
 use base qw(DynaLoader);
 
 bootstrap Devel::Declare;
@@ -22,7 +23,7 @@
   my $target = caller;
   if (@_ == 1) { # "use Devel::Declare;"
     no strict 'refs';
-    foreach my $name (qw(NAME PROTO NONE)) {
+    foreach my $name (qw(NAME PROTO NONE PACKAGE)) {
       *{"${target}::DECLARE_${name}"} = *{"DECLARE_${name}"};
     }
   } else {
@@ -62,7 +63,6 @@
   teardown();
 }
 
-my $temp_pack;
 my $temp_name;
 my $temp_save;
 
@@ -72,17 +72,18 @@
        = $declarator_handlers{$pack}{$use}->(
            $pack, $use, $name, $proto, defined(wantarray)
          );
-  ($temp_pack, $temp_name, $temp_save) = ($pack, [], []);
+  ($temp_name, $temp_save) = ([], []);
   if ($name) {
+    $name = "${pack}::${name}" unless $name =~ /::/;
     push(@$temp_name, $name);
     no strict 'refs';
-    push(@$temp_save, \&{"${pack}::${name}"});
+    push(@$temp_save, \&{$name});
     no warnings 'redefine';
     no warnings 'prototype';
-    *{"${pack}::${name}"} = $name_h;
+    *{$name} = $name_h;
   }
   if ($XX_h) {
-    push(@$temp_name, 'X');
+    push(@$temp_name, "${pack}::X");
     no strict 'refs';
     push(@$temp_save, \&{"${pack}::X"});
     no warnings 'redefine';
@@ -101,6 +102,8 @@
   my $name = pop(@{$temp_name||[]});
   die "done_declare called with no temp_name stack" unless defined($name);
   my $saved = pop(@$temp_save);
+  $name =~ s/(.*):://;
+  my $temp_pack = $1;
   delete ${"${temp_pack}::"}{$name};
   if ($saved) {
     no warnings 'prototype';
@@ -108,10 +111,6 @@
   }
 }
 
-sub inject_into_next_pad {
-  shift; @next_pad_inject = @_;
-}
-
 =head1 NAME
 
 Devel::Declare - 

Added: trunk/Devel-Declare/t/pack.t
===================================================================
--- trunk/Devel-Declare/t/pack.t	                        (rev 0)
+++ trunk/Devel-Declare/t/pack.t	2007-07-01 18:42:26 UTC (rev 3554)
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+sub class { $_[0]->(); }
+
+sub handle_class {
+  my ($pack, $use, $name, $proto, $is_block) = @_;
+  return (sub (&) { shift; }, undef, "package ${name};");
+}
+
+use Devel::Declare;
+use Devel::Declare 'class' => [ DECLARE_PACKAGE, \&handle_class ];
+
+my $packname;
+
+class Foo::Bar {
+  $packname = __PACKAGE__;
+};
+
+is($packname, 'Foo::Bar', 'Package saved ok');
+is(__PACKAGE__, 'main', 'Package scoped correctly');