#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);
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
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;
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 {
teardown();
}
-my $temp_pack;
my $temp_name;
my $temp_save;
= $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';
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';
}
}
-sub inject_into_next_pad {
- shift; @next_pad_inject = @_;
-}
-
=head1 NAME
Devel::Declare -
--- /dev/null
+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');