diff options
| -rw-r--r-- | Stash.xs | 28 | ||||
| -rw-r--r-- | dist.ini | 1 | ||||
| -rw-r--r-- | lib/Package/Stash.pm | 67 | ||||
| -rw-r--r-- | t/01-basic.t | 154 | ||||
| -rw-r--r-- | t/02-extension.t | 16 | ||||
| -rw-r--r-- | t/03-io.t | 26 | ||||
| -rw-r--r-- | t/04-get.t | 52 | ||||
| -rw-r--r-- | t/05-isa.t | 2 | ||||
| -rw-r--r-- | t/06-addsub.t | 4 | ||||
| -rwxr-xr-x | t/07-edge-cases.t | 20 | ||||
| -rw-r--r-- | t/10-synopsis.t | 4 | ||||
| -rw-r--r-- | t/20-leaks.t | 102 |
12 files changed, 261 insertions, 215 deletions
@@ -198,7 +198,7 @@ SV *_get_name(SV *self) return ret; } -SV *_get_package_symbol(SV *self, varspec_t *variable, int vivify) +SV *_get_symbol(SV *self, varspec_t *variable, int vivify) { HV *namespace; SV **entry; @@ -326,7 +326,7 @@ namespace(self) RETVAL void -add_package_symbol(self, variable, initial=NULL, ...) +add_symbol(self, variable, initial=NULL, ...) SV *self varspec_t variable SV *initial @@ -362,24 +362,24 @@ add_package_symbol(self, variable, initial=NULL, ...) I32 first_line_num, last_line_num; if ((items - 3) % 2) - croak("add_package_symbol: Odd number of elements in %%opts"); + croak("add_symbol: Odd number of elements in %%opts"); for (i = 3; i < items; i += 2) { char *key; key = SvPV_nolen(ST(i)); if (strEQ(key, "filename")) { if (!SvPOK(ST(i + 1))) - croak("add_package_symbol: filename must be a string"); + croak("add_symbol: filename must be a string"); filename = SvPV_nolen(ST(i + 1)); } else if (strEQ(key, "first_line_num")) { if (!SvIOK(ST(i + 1))) - croak("add_package_symbol: first_line_num must be an integer"); + croak("add_symbol: first_line_num must be an integer"); first_line_num = SvIV(ST(i + 1)); } else if (strEQ(key, "last_line_num")) { if (!SvIOK(ST(i + 1))) - croak("add_package_symbol: last_line_num must be an integer"); + croak("add_symbol: last_line_num must be an integer"); last_line_num = SvIV(ST(i + 1)); } } @@ -436,14 +436,14 @@ add_package_symbol(self, variable, initial=NULL, ...) SvREFCNT_dec(name); void -remove_package_glob(self, name) +remove_glob(self, name) SV *self char *name CODE: hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD); int -has_package_symbol(self, variable) +has_symbol(self, variable) SV *self varspec_t variable PREINIT: @@ -482,13 +482,13 @@ has_package_symbol(self, variable) RETVAL SV* -get_package_symbol(self, variable) +get_symbol(self, variable) SV *self varspec_t variable PREINIT: SV *val; CODE: - val = _get_package_symbol(self, &variable, 0); + val = _get_symbol(self, &variable, 0); if (!val) XSRETURN_UNDEF; RETVAL = newRV_inc(val); @@ -496,13 +496,13 @@ get_package_symbol(self, variable) RETVAL SV* -get_or_add_package_symbol(self, variable) +get_or_add_symbol(self, variable) SV *self varspec_t variable PREINIT: SV *val; CODE: - val = _get_package_symbol(self, &variable, 1); + val = _get_symbol(self, &variable, 1); if (!val) XSRETURN_UNDEF; RETVAL = newRV_inc(val); @@ -510,7 +510,7 @@ get_or_add_package_symbol(self, variable) RETVAL void -remove_package_symbol(self, variable) +remove_symbol(self, variable) SV *self varspec_t variable PREINIT: @@ -551,7 +551,7 @@ remove_package_symbol(self, variable) } void -list_all_package_symbols(self, vartype=VAR_NONE) +list_all_symbols(self, vartype=VAR_NONE) SV *self vartype_t vartype PPCODE: @@ -9,6 +9,7 @@ dist = Package-Stash awesome = =inc::MMPackageStash [Prereqs] +Package::DeprecationManager = 0 Scalar::Util = 0 [Prereqs / TestRequires] diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index f385053..5811d7e 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -14,12 +14,57 @@ XSLoader::load( ? ${ $Package::Stash::{VERSION} } : (), ); +use Package::DeprecationManager -deprecations => { + 'Package::Stash::add_package_symbol' => 0.14, + 'Package::Stash::remove_package_glob' => 0.14, + 'Package::Stash::has_package_symbol' => 0.14, + 'Package::Stash::get_package_symbol' => 0.14, + 'Package::Stash::get_or_add_package_symbol' => 0.14, + 'Package::Stash::remove_package_symbol' => 0.14, + 'Package::Stash::list_all_package_symbols' => 0.14, +}; + +sub add_package_symbol { + deprecated('add_package_symbol is deprecated, please use add_symbol'); + shift->add_symbol(@_); +} + +sub remove_package_glob { + deprecated('remove_package_glob is deprecated, please use remove_glob'); + shift->remove_glob(@_); +} + +sub has_package_symbol { + deprecated('has_package_symbol is deprecated, please use has_symbol'); + shift->has_symbol(@_); +} + +sub get_package_symbol { + deprecated('get_package_symbol is deprecated, please use get_symbol'); + shift->get_symbol(@_); +} + +sub get_or_add_package_symbol { + deprecated('get_or_add_package_symbol is deprecated, please use get_or_add_symbol'); + shift->get_or_add_symbol(@_); +} + +sub remove_package_symbol { + deprecated('remove_package_symbol is deprecated, please use remove_symbol'); + shift->remove_symbol(@_); +} + +sub list_all_package_symbols { + deprecated('list_all_package_symbols is deprecated, please use list_all_symbols'); + shift->list_all_symbols(@_); +} + =head1 SYNOPSIS my $stash = Package::Stash->new('Foo'); - $stash->add_package_symbol('%foo', {bar => 1}); + $stash->add_symbol('%foo', {bar => 1}); # $Foo::foo{bar} == 1 - $stash->has_package_symbol('$foo') # false + $stash->has_symbol('$foo') # false my $namespace = $stash->namespace; *{ $namespace->{foo} }{HASH} # {bar => 1} @@ -45,13 +90,13 @@ Returns the name of the package that this object represents. Returns the raw stash itself. -=method add_package_symbol $variable $value %opts +=method add_symbol $variable $value %opts Adds a new package symbol, for the symbol given as C<$variable>, and optionally gives it an initial value of C<$value>. C<$variable> should be the name of variable including the sigil, so - Package::Stash->new('Foo')->add_package_symbol('%foo') + Package::Stash->new('Foo')->add_symbol('%foo') will create C<%Foo::foo>. @@ -71,30 +116,30 @@ determine where the source code for a subroutine can be found. See L<http://perldoc.perl.org/perldebguts.html#Debugger-Internals> for more information about C<%DB::sub>. -=method remove_package_glob $name +=method remove_glob $name Removes all package variables with the given name, regardless of sigil. -=method has_package_symbol $variable +=method has_symbol $variable Returns whether or not the given package variable (including sigil) exists. -=method get_package_symbol $variable +=method get_symbol $variable Returns the value of the given package variable (including sigil). -=method get_or_add_package_symbol $variable +=method get_or_add_symbol $variable -Like C<get_package_symbol>, except that it will return an empty hashref or +Like C<get_symbol>, except that it will return an empty hashref or arrayref if the variable doesn't exist. -=method remove_package_symbol $variable +=method remove_symbol $variable Removes the package variable described by C<$variable> (which includes the sigil); other variables with the same name but different sigils will be untouched. -=method list_all_package_symbols $type_filter +=method list_all_symbols $type_filter Returns a list of package variable names in the package, without sigils. If a C<type_filter> is passed, it is used to select package variables of a given diff --git a/t/01-basic.t b/t/01-basic.t index 2268aef..2188e07 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -20,21 +20,21 @@ like(exception { Package::Stash->name }, qr/Can't call name as a class method/, my $foo_stash = Package::Stash->new('Foo'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); -ok(!$foo_stash->has_package_symbol('%foo'), '... the object agrees'); +ok(!$foo_stash->has_symbol('%foo'), '... the object agrees'); ok(!defined($Foo::{foo}), '... checking doesn\' vivify'); is(exception { - $foo_stash->add_package_symbol('%foo' => { one => 1 }); + $foo_stash->add_symbol('%foo' => { one => 1 }); }, undef, '... created %Foo::foo successfully'); # ... scalar should NOT be created here -ok(!$foo_stash->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('&foo'), '... CODE shouldnt have been created too'); +ok(!$foo_stash->has_symbol('$foo'), '... SCALAR shouldnt have been created too'); +ok(!$foo_stash->has_symbol('@foo'), '... ARRAY shouldnt have been created too'); +ok(!$foo_stash->has_symbol('&foo'), '... CODE shouldnt have been created too'); ok(defined($Foo::{foo}), '... the %foo slot was created successfully'); -ok($foo_stash->has_package_symbol('%foo'), '... the meta agrees'); +ok($foo_stash->has_symbol('%foo'), '... the meta agrees'); # check the value ... @@ -44,7 +44,7 @@ ok($foo_stash->has_package_symbol('%foo'), '... the meta agrees'); is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly'); } -my $foo = $foo_stash->get_package_symbol('%foo'); +my $foo = $foo_stash->get_symbol('%foo'); is_deeply({ one => 1 }, $foo, '... got the right package variable back'); # ... make sure changes propogate up @@ -53,7 +53,7 @@ $foo->{two} = 2; { no strict 'refs'; - is(\%{'Foo::foo'}, $foo_stash->get_package_symbol('%foo'), '... our %foo is the same as the metas'); + is(\%{'Foo::foo'}, $foo_stash->get_symbol('%foo'), '... our %foo is the same as the metas'); ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly'); is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly'); @@ -65,17 +65,17 @@ $foo->{two} = 2; ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); + $foo_stash->add_symbol('@bar' => [ 1, 2, 3 ]); }, undef, '... created @Foo::bar successfully'); ok(defined($Foo::{bar}), '... the @bar slot was created successfully'); -ok($foo_stash->has_package_symbol('@bar'), '... the meta agrees'); +ok($foo_stash->has_symbol('@bar'), '... the meta agrees'); # ... why does this not work ... -ok(!$foo_stash->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('%bar'), '... HASH shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('&bar'), '... CODE shouldnt have been created too'); +ok(!$foo_stash->has_symbol('$bar'), '... SCALAR shouldnt have been created too'); +ok(!$foo_stash->has_symbol('%bar'), '... HASH shouldnt have been created too'); +ok(!$foo_stash->has_symbol('&bar'), '... CODE shouldnt have been created too'); # check the value itself @@ -91,24 +91,24 @@ ok(!$foo_stash->has_package_symbol('&bar'), '... CODE shouldnt have been created ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('$baz' => 10); + $foo_stash->add_symbol('$baz' => 10); }, undef, '... created $Foo::baz successfully'); ok(defined($Foo::{baz}), '... the $baz slot was created successfully'); -ok($foo_stash->has_package_symbol('$baz'), '... the meta agrees'); +ok($foo_stash->has_symbol('$baz'), '... the meta agrees'); -ok(!$foo_stash->has_package_symbol('@baz'), '... ARRAY shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('%baz'), '... HASH shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('&baz'), '... CODE shouldnt have been created too'); +ok(!$foo_stash->has_symbol('@baz'), '... ARRAY shouldnt have been created too'); +ok(!$foo_stash->has_symbol('%baz'), '... HASH shouldnt have been created too'); +ok(!$foo_stash->has_symbol('&baz'), '... CODE shouldnt have been created too'); -is(${$foo_stash->get_package_symbol('$baz')}, 10, '... got the right value back'); +is(${$foo_stash->get_symbol('$baz')}, 10, '... got the right value back'); { no strict 'refs'; ${'Foo::baz'} = 1; is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly'); - is(${$foo_stash->get_package_symbol('$baz')}, 1, '... the meta agrees'); + is(${$foo_stash->get_symbol('$baz')}, 1, '... the meta agrees'); } # ---------------------------------------------------------------------- @@ -117,15 +117,15 @@ is(${$foo_stash->get_package_symbol('$baz')}, 10, '... got the right value back' ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk" }); + $foo_stash->add_symbol('&funk' => sub { "Foo::funk" }); }, undef, '... created &Foo::funk successfully'); ok(defined($Foo::{funk}), '... the &funk slot was created successfully'); -ok($foo_stash->has_package_symbol('&funk'), '... the meta agrees'); +ok($foo_stash->has_symbol('&funk'), '... the meta agrees'); -ok(!$foo_stash->has_package_symbol('$funk'), '... SCALAR shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('@funk'), '... ARRAY shouldnt have been created too'); -ok(!$foo_stash->has_package_symbol('%funk'), '... HASH shouldnt have been created too'); +ok(!$foo_stash->has_symbol('$funk'), '... SCALAR shouldnt have been created too'); +ok(!$foo_stash->has_symbol('@funk'), '... ARRAY shouldnt have been created too'); +ok(!$foo_stash->has_symbol('%funk'), '... HASH shouldnt have been created too'); { no strict 'refs'; @@ -141,25 +141,25 @@ my $ARRAY = [ 1, 2, 3 ]; my $CODE = sub { "Foo::foo" }; is(exception { - $foo_stash->add_package_symbol('@foo' => $ARRAY); + $foo_stash->add_symbol('@foo' => $ARRAY); }, undef, '... created @Foo::foo successfully'); -ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot was added successfully'); -is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); +ok($foo_stash->has_symbol('@foo'), '... the @foo slot was added successfully'); +is($foo_stash->get_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); is(exception { - $foo_stash->add_package_symbol('&foo' => $CODE); + $foo_stash->add_symbol('&foo' => $CODE); }, undef, '... created &Foo::foo successfully'); -ok($foo_stash->has_package_symbol('&foo'), '... the meta agrees'); -is($foo_stash->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo'); +ok($foo_stash->has_symbol('&foo'), '... the meta agrees'); +is($foo_stash->get_symbol('&foo'), $CODE, '... got the right value for &Foo::foo'); is(exception { - $foo_stash->add_package_symbol('$foo' => 'Foo::foo'); + $foo_stash->add_symbol('$foo' => 'Foo::foo'); }, undef, '... created $Foo::foo successfully'); -ok($foo_stash->has_package_symbol('$foo'), '... the meta agrees'); -my $SCALAR = $foo_stash->get_package_symbol('$foo'); +ok($foo_stash->has_symbol('$foo'), '... the meta agrees'); +my $SCALAR = $foo_stash->get_symbol('$foo'); is($$SCALAR, 'Foo::foo', '... got the right scalar value back'); { @@ -168,17 +168,17 @@ is($$SCALAR, 'Foo::foo', '... got the right scalar value back'); } is(exception { - $foo_stash->remove_package_symbol('%foo'); + $foo_stash->remove_symbol('%foo'); }, undef, '... removed %Foo::foo successfully'); -ok(!$foo_stash->has_package_symbol('%foo'), '... the %foo slot was removed successfully'); -ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot still exists'); -ok($foo_stash->has_package_symbol('&foo'), '... the &foo slot still exists'); -ok($foo_stash->has_package_symbol('$foo'), '... the $foo slot still exists'); +ok(!$foo_stash->has_symbol('%foo'), '... the %foo slot was removed successfully'); +ok($foo_stash->has_symbol('@foo'), '... the @foo slot still exists'); +ok($foo_stash->has_symbol('&foo'), '... the &foo slot still exists'); +ok($foo_stash->has_symbol('$foo'), '... the $foo slot still exists'); -is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); -is($foo_stash->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo'); -is($foo_stash->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo'); +is($foo_stash->get_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); +is($foo_stash->get_symbol('&foo'), $CODE, '... got the right value for &Foo::foo'); +is($foo_stash->get_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo'); { no strict 'refs'; @@ -189,16 +189,16 @@ is($foo_stash->get_package_symbol('$foo'), $SCALAR, '... got the right value for } is(exception { - $foo_stash->remove_package_symbol('&foo'); + $foo_stash->remove_symbol('&foo'); }, undef, '... removed &Foo::foo successfully'); -ok(!$foo_stash->has_package_symbol('&foo'), '... the &foo slot no longer exists'); +ok(!$foo_stash->has_symbol('&foo'), '... the &foo slot no longer exists'); -ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot still exists'); -ok($foo_stash->has_package_symbol('$foo'), '... the $foo slot still exists'); +ok($foo_stash->has_symbol('@foo'), '... the @foo slot still exists'); +ok($foo_stash->has_symbol('$foo'), '... the $foo slot still exists'); -is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); -is($foo_stash->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo'); +is($foo_stash->get_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); +is($foo_stash->get_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo'); { no strict 'refs'; @@ -209,14 +209,14 @@ is($foo_stash->get_package_symbol('$foo'), $SCALAR, '... got the right value for } is(exception { - $foo_stash->remove_package_symbol('$foo'); + $foo_stash->remove_symbol('$foo'); }, undef, '... removed $Foo::foo successfully'); -ok(!$foo_stash->has_package_symbol('$foo'), '... the $foo slot no longer exists'); +ok(!$foo_stash->has_symbol('$foo'), '... the $foo slot no longer exists'); -ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot still exists'); +ok($foo_stash->has_symbol('@foo'), '... the @foo slot still exists'); -is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); +is($foo_stash->get_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); { no strict 'refs'; @@ -229,15 +229,15 @@ is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for # check some errors like(exception { - $foo_stash->add_package_symbol('@bar', {}) + $foo_stash->add_symbol('@bar', {}) }, qr/HASH.*is not of type ARRAY/, "can't initialize a slot with the wrong type of value"); like(exception { - $foo_stash->add_package_symbol('bar', []) + $foo_stash->add_symbol('bar', []) }, qr/ARRAY.*is not of type IO/, "can't initialize a slot with the wrong type of value"); like(exception { - $foo_stash->add_package_symbol('$bar', sub { }) + $foo_stash->add_symbol('$bar', sub { }) }, qr/CODE.*is not of type SCALAR/, "can't initialize a slot with the wrong type of value"); { @@ -246,7 +246,7 @@ like(exception { } like(exception { - $foo_stash->add_package_symbol('$bar', *Bar::foo{IO}) + $foo_stash->add_symbol('$bar', *Bar::foo{IO}) }, qr/IO.*is not of type SCALAR/, "can't initialize a slot with the wrong type of value"); # check compile time manipulation @@ -259,16 +259,16 @@ like(exception { our %foo = (baz => 1); sub foo { } open *foo, '<', $0; - BEGIN { Package::Stash->new(__PACKAGE__)->remove_package_symbol('&foo') } + BEGIN { Package::Stash->new(__PACKAGE__)->remove_symbol('&foo') } } { my $stash = Package::Stash->new('Baz'); - is(${ $stash->get_package_symbol('$foo') }, 23, "got \$foo"); - is_deeply($stash->get_package_symbol('@foo'), ['bar'], "got \@foo"); - is_deeply($stash->get_package_symbol('%foo'), {baz => 1}, "got \%foo"); - ok(!$stash->has_package_symbol('&foo'), "got \&foo"); - is($stash->get_package_symbol('foo'), *Baz::foo{IO}, "got foo"); + is(${ $stash->get_symbol('$foo') }, 23, "got \$foo"); + is_deeply($stash->get_symbol('@foo'), ['bar'], "got \@foo"); + is_deeply($stash->get_symbol('%foo'), {baz => 1}, "got \%foo"); + ok(!$stash->has_symbol('&foo'), "got \&foo"); + is($stash->get_symbol('foo'), *Baz::foo{IO}, "got foo"); } { @@ -294,31 +294,31 @@ like(exception { for my $sym ( sort keys %expect ) { is_deeply( - $stash->get_package_symbol($sym), + $stash->get_symbol($sym), $expect{$sym}, "got expected value for $sym" ); } - $stash->add_package_symbol('%bar' => {x => 42}); + $stash->add_symbol('%bar' => {x => 42}); $expect{'%bar'} = {x => 42}; for my $sym ( sort keys %expect ) { is_deeply( - $stash->get_package_symbol($sym), + $stash->get_symbol($sym), $expect{$sym}, "got expected value for $sym" ); } - $stash->add_package_symbol('%bar' => {x => 43}); + $stash->add_symbol('%bar' => {x => 43}); $expect{'%bar'} = {x => 43}; for my $sym ( sort keys %expect ) { is_deeply( - $stash->get_package_symbol($sym), + $stash->get_symbol($sym), $expect{$sym}, "got expected value for $sym" ); @@ -340,29 +340,29 @@ like(exception { { my $quuux = Package::Stash->new('Quuux'); is_deeply( - [sort $quuux->list_all_package_symbols], + [sort $quuux->list_all_symbols], [qw(BEGIN bar baz foo quuuux quuux quux)], - "list_all_package_symbols", + "list_all_symbols", ); is_deeply( - [sort $quuux->list_all_package_symbols('SCALAR')], + [sort $quuux->list_all_symbols('SCALAR')], [qw(foo)], - "list_all_package_symbols SCALAR", + "list_all_symbols SCALAR", ); is_deeply( - [sort $quuux->list_all_package_symbols('ARRAY')], + [sort $quuux->list_all_symbols('ARRAY')], [qw(bar foo)], - "list_all_package_symbols ARRAY", + "list_all_symbols ARRAY", ); is_deeply( - [sort $quuux->list_all_package_symbols('HASH')], + [sort $quuux->list_all_symbols('HASH')], [qw(baz)], - "list_all_package_symbols HASH", + "list_all_symbols HASH", ); is_deeply( - [sort $quuux->list_all_package_symbols('CODE')], + [sort $quuux->list_all_symbols('CODE')], [qw(baz quuuux quuux quux)], - "list_all_package_symbols CODE", + "list_all_symbols CODE", ); } diff --git a/t/02-extension.t b/t/02-extension.t index 0136b1a..5e88fa6 100644 --- a/t/02-extension.t +++ b/t/02-extension.t @@ -20,7 +20,7 @@ use Test::Fatal; return $self; } - sub add_package_symbol { + sub add_symbol { my ($self, $variable, $initial_value) = @_; (my $name = $variable) =~ s/^[\$\@\%\&]//; @@ -38,26 +38,26 @@ isa_ok($foo_stash, 'My::Package::Stash'); isa_ok($foo_stash, 'Package::Stash'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); -ok(!$foo_stash->has_package_symbol('%foo'), '... the foo_stash agrees'); +ok(!$foo_stash->has_symbol('%foo'), '... the foo_stash agrees'); is(exception { - $foo_stash->add_package_symbol('%foo' => { one => 1 }); + $foo_stash->add_symbol('%foo' => { one => 1 }); }, undef, '... the %foo symbol is created succcessfully'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created in the actual Foo package'); -ok($foo_stash->has_package_symbol('%foo'), '... the foo_stash agrees'); +ok($foo_stash->has_symbol('%foo'), '... the foo_stash agrees'); -my $foo = $foo_stash->get_package_symbol('%foo'); +my $foo = $foo_stash->get_symbol('%foo'); is_deeply({ one => 1 }, $foo, '... got the right package variable back'); $foo->{two} = 2; -is($foo, $foo_stash->get_package_symbol('%foo'), '... our %foo is the same as the foo_stashs'); +is($foo, $foo_stash->get_symbol('%foo'), '... our %foo is the same as the foo_stashs'); ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); + $foo_stash->add_symbol('@bar' => [ 1, 2, 3 ]); }, undef, '... created @Foo::bar successfully'); ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); @@ -65,7 +65,7 @@ ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('%baz'); + $foo_stash->add_symbol('%baz'); }, undef, '... created %Foo::baz successfully'); ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); @@ -22,29 +22,29 @@ use Package::Stash; { my $stash = Package::Stash->new('Foo'); - ok($stash->has_package_symbol('&foo'), "has &foo"); - ok($stash->has_package_symbol('foo'), "has foo"); - $stash->remove_package_symbol('&foo'); - ok(!$stash->has_package_symbol('&foo'), "has &foo"); - ok($stash->has_package_symbol('foo'), "has foo"); + ok($stash->has_symbol('&foo'), "has &foo"); + ok($stash->has_symbol('foo'), "has foo"); + $stash->remove_symbol('&foo'); + ok(!$stash->has_symbol('&foo'), "has &foo"); + ok($stash->has_symbol('foo'), "has foo"); } { my $stash = Package::Stash->new('Bar'); - ok($stash->has_package_symbol('&bar'), "has &bar"); - ok($stash->has_package_symbol('bar'), "has bar"); - $stash->remove_package_symbol('bar'); - ok($stash->has_package_symbol('&bar'), "has &bar"); - ok(!$stash->has_package_symbol('bar'), "has bar"); + ok($stash->has_symbol('&bar'), "has &bar"); + ok($stash->has_symbol('bar'), "has bar"); + $stash->remove_symbol('bar'); + ok($stash->has_symbol('&bar'), "has &bar"); + ok(!$stash->has_symbol('bar'), "has bar"); } { my $stash = Package::Stash->new('Baz'); is(exception { - $stash->add_package_symbol('baz', *Foo::foo{IO}); + $stash->add_symbol('baz', *Foo::foo{IO}); }, undef, "can add an IO symbol"); - ok($stash->has_package_symbol('baz'), "has baz"); - is($stash->get_package_symbol('baz'), *Foo::foo{IO}, "got the right baz"); + ok($stash->has_symbol('baz'), "has baz"); + is($stash->get_symbol('baz'), *Foo::foo{IO}, "got the right baz"); } done_testing; @@ -9,7 +9,7 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Hash'); - my $val = $stash->get_package_symbol('%foo'); + my $val = $stash->get_symbol('%foo'); is($val, undef, "got nothing yet"); } { @@ -18,10 +18,10 @@ use Scalar::Util; } BEGIN { my $stash = Package::Stash->new('Hash'); - my $val = $stash->get_package_symbol('%foo'); + my $val = $stash->get_symbol('%foo'); is(ref($val), 'HASH', "got something"); $val->{bar} = 1; - is_deeply($stash->get_package_symbol('%foo'), {bar => 1}, + is_deeply($stash->get_symbol('%foo'), {bar => 1}, "got the right variable"); is_deeply(\%Hash::foo, {bar => 1}, "stash has the right variable"); @@ -31,7 +31,7 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Array'); - my $val = $stash->get_package_symbol('@foo'); + my $val = $stash->get_symbol('@foo'); is($val, undef, "got nothing yet"); } { @@ -40,10 +40,10 @@ use Scalar::Util; } BEGIN { my $stash = Package::Stash->new('Array'); - my $val = $stash->get_package_symbol('@foo'); + my $val = $stash->get_symbol('@foo'); is(ref($val), 'ARRAY', "got something"); push @$val, 1; - is_deeply($stash->get_package_symbol('@foo'), [1], + is_deeply($stash->get_symbol('@foo'), [1], "got the right variable"); is_deeply(\@Array::foo, [1], "stash has the right variable"); @@ -53,7 +53,7 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Scalar'); - my $val = $stash->get_package_symbol('$foo'); + my $val = $stash->get_symbol('$foo'); is($val, undef, "got nothing yet"); } { @@ -62,10 +62,10 @@ use Scalar::Util; } BEGIN { my $stash = Package::Stash->new('Scalar'); - my $val = $stash->get_package_symbol('$foo'); + my $val = $stash->get_symbol('$foo'); is(ref($val), 'SCALAR', "got something"); $$val = 1; - is_deeply($stash->get_package_symbol('$foo'), \1, + is_deeply($stash->get_symbol('$foo'), \1, "got the right variable"); is($Scalar::foo, 1, "stash has the right variable"); @@ -75,7 +75,7 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Code'); - my $val = $stash->get_package_symbol('&foo'); + my $val = $stash->get_symbol('&foo'); is($val, undef, "got nothing yet"); } { @@ -84,13 +84,13 @@ use Scalar::Util; } BEGIN { my $stash = Package::Stash->new('Code'); - my $val = $stash->get_package_symbol('&foo'); + my $val = $stash->get_symbol('&foo'); is(ref($val), 'CODE', "got something"); is(prototype($val), undef, "got the right variable"); &Scalar::Util::set_prototype($val, '&'); - is($stash->get_package_symbol('&foo'), $val, + is($stash->get_symbol('&foo'), $val, "got the right variable"); - is(prototype($stash->get_package_symbol('&foo')), '&', + is(prototype($stash->get_symbol('&foo')), '&', "got the right variable"); is(prototype(\&Code::foo), '&', "stash has the right variable"); @@ -100,7 +100,7 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Io'); - my $val = $stash->get_package_symbol('FOO'); + my $val = $stash->get_symbol('FOO'); is($val, undef, "got nothing yet"); } { @@ -110,13 +110,13 @@ use Scalar::Util; } BEGIN { my $stash = Package::Stash->new('Io'); - my $val = $stash->get_package_symbol('FOO'); + my $val = $stash->get_symbol('FOO'); isa_ok($val, 'IO'); my $str = "foo"; open $val, '<', \$str; - is(readline($stash->get_package_symbol('FOO')), "foo", + is(readline($stash->get_symbol('FOO')), "foo", "got the right variable"); - seek($stash->get_package_symbol('FOO'), 0, 0); + seek($stash->get_symbol('FOO'), 0, 0); { package Io; ::isa_ok(*FOO{IO}, 'IO'); @@ -128,10 +128,10 @@ use Scalar::Util; { my $stash = Package::Stash->new('Hash::Vivify'); - my $val = $stash->get_or_add_package_symbol('%foo'); + my $val = $stash->get_or_add_symbol('%foo'); is(ref($val), 'HASH', "got something"); $val->{bar} = 1; - is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1}, + is_deeply($stash->get_or_add_symbol('%foo'), {bar => 1}, "got the right variable"); no warnings 'once'; is_deeply(\%Hash::Vivify::foo, {bar => 1}, @@ -140,10 +140,10 @@ use Scalar::Util; { my $stash = Package::Stash->new('Array::Vivify'); - my $val = $stash->get_or_add_package_symbol('@foo'); + my $val = $stash->get_or_add_symbol('@foo'); is(ref($val), 'ARRAY', "got something"); push @$val, 1; - is_deeply($stash->get_or_add_package_symbol('@foo'), [1], + is_deeply($stash->get_or_add_symbol('@foo'), [1], "got the right variable"); no warnings 'once'; is_deeply(\@Array::Vivify::foo, [1], @@ -152,10 +152,10 @@ use Scalar::Util; { my $stash = Package::Stash->new('Scalar::Vivify'); - my $val = $stash->get_or_add_package_symbol('$foo'); + my $val = $stash->get_or_add_symbol('$foo'); is(ref($val), 'SCALAR', "got something"); $$val = 1; - is_deeply($stash->get_or_add_package_symbol('$foo'), \1, + is_deeply($stash->get_or_add_symbol('$foo'), \1, "got the right variable"); no warnings 'once'; is($Scalar::Vivify::foo, 1, @@ -165,13 +165,13 @@ use Scalar::Util; { BEGIN { my $stash = Package::Stash->new('Io::Vivify'); - my $val = $stash->get_or_add_package_symbol('FOO'); + my $val = $stash->get_or_add_symbol('FOO'); isa_ok($val, 'IO'); my $str = "foo"; open $val, '<', \$str; - is(readline($stash->get_package_symbol('FOO')), "foo", + is(readline($stash->get_symbol('FOO')), "foo", "got the right variable"); - seek($stash->get_package_symbol('FOO'), 0, 0); + seek($stash->get_symbol('FOO'), 0, 0); } { package Io::Vivify; @@ -15,7 +15,7 @@ use Package::Stash; my $stash = Package::Stash->new('Foo'); my @ISA = ('Bar'); -@{$stash->get_or_add_package_symbol('@ISA')} = @ISA; +@{$stash->get_or_add_symbol('@ISA')} = @ISA; isa_ok('Foo', 'Bar'); done_testing; diff --git a/t/06-addsub.t b/t/06-addsub.t index 860a5c0..50a67fd 100644 --- a/t/06-addsub.t +++ b/t/06-addsub.t @@ -16,7 +16,7 @@ my $foo_stash = Package::Stash->new('Foo'); ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); is(exception { - $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk", __LINE__ }); + $foo_stash->add_symbol('&funk' => sub { "Foo::funk", __LINE__ }); }, undef, '... created &Foo::funk successfully'); ok(defined($Foo::{funk}), '... the &funk slot was created successfully'); @@ -33,7 +33,7 @@ my $line = (Foo->funk())[1]; is $DB::sub{'Foo::funk'}, sprintf "%s:%d-%d", __FILE__, $line, $line, '... got the right %DB::sub value for funk default args'; -$foo_stash->add_package_symbol( +$foo_stash->add_symbol( '&dunk' => sub { "Foo::dunk" }, filename => "FileName", first_line_num => 100, diff --git a/t/07-edge-cases.t b/t/07-edge-cases.t index e5928a5..75df7ac 100755 --- a/t/07-edge-cases.t +++ b/t/07-edge-cases.t @@ -24,22 +24,22 @@ use Package::Stash; } my $stash = Package::Stash->new('Foo'); -ok($stash->has_package_symbol('$SCALAR'), '$SCALAR'); -ok($stash->has_package_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE'); -ok($stash->has_package_symbol('@ARRAY'), '@ARRAY'); -ok($stash->has_package_symbol('%HASH'), '%HASH'); +ok($stash->has_symbol('$SCALAR'), '$SCALAR'); +ok($stash->has_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE'); +ok($stash->has_symbol('@ARRAY'), '@ARRAY'); +ok($stash->has_symbol('%HASH'), '%HASH'); is_deeply( - [sort $stash->list_all_package_symbols('CODE')], + [sort $stash->list_all_symbols('CODE')], [qw(BAR BAZ FOO QUUUX QUUX normal normal_with_proto stub stub_with_proto)], "can see all code symbols" ); -$stash->add_package_symbol('%added', {}); -ok(!$stash->has_package_symbol('$added'), '$added'); -ok(!$stash->has_package_symbol('@added'), '@added'); -ok($stash->has_package_symbol('%added'), '%added'); +$stash->add_symbol('%added', {}); +ok(!$stash->has_symbol('$added'), '$added'); +ok(!$stash->has_symbol('@added'), '@added'); +ok($stash->has_symbol('%added'), '%added'); -my $constant = $stash->get_package_symbol('&FOO'); +my $constant = $stash->get_symbol('&FOO'); is(ref($constant), 'CODE', "expanded a constant into a coderef"); done_testing; diff --git a/t/10-synopsis.t b/t/10-synopsis.t index 4c93f32..ecde8b6 100644 --- a/t/10-synopsis.t +++ b/t/10-synopsis.t @@ -6,12 +6,12 @@ use Test::More; use Package::Stash; my $stash = Package::Stash->new('Foo'); -$stash->add_package_symbol('%foo', {bar => 1}); +$stash->add_symbol('%foo', {bar => 1}); { no warnings 'once'; is($Foo::foo{bar}, 1, "set in the stash properly"); } -ok(!$stash->has_package_symbol('$foo'), "doesn't have anything in scalar slot"); +ok(!$stash->has_symbol('$foo'), "doesn't have anything in scalar slot"); my $namespace = $stash->namespace; is_deeply(*{ $namespace->{foo} }{HASH}, {bar => 1}, "namespace works properly"); diff --git a/t/20-leaks.t b/t/20-leaks.t index caebd4f..7d3f5eb 100644 --- a/t/20-leaks.t +++ b/t/20-leaks.t @@ -49,22 +49,22 @@ use Symbol; { my $foo = Package::Stash->new('Foo'); no_leaks_ok { - $foo->add_package_symbol('$scalar'); - $foo->add_package_symbol('@array'); - $foo->add_package_symbol('%hash'); - $foo->add_package_symbol('io'); - } "add_package_symbol doesn't leak"; + $foo->add_symbol('$scalar'); + $foo->add_symbol('@array'); + $foo->add_symbol('%hash'); + $foo->add_symbol('io'); + } "add_symbol doesn't leak"; } { my $foo = Package::Stash->new('Foo'); no_leaks_ok { - $foo->add_package_symbol('$scalar_init' => 1); - $foo->add_package_symbol('@array_init' => []); - $foo->add_package_symbol('%hash_init' => {}); - $foo->add_package_symbol('&code_init' => sub { "foo" }); - $foo->add_package_symbol('io_init' => Symbol::geniosym); - } "add_package_symbol doesn't leak"; + $foo->add_symbol('$scalar_init' => 1); + $foo->add_symbol('@array_init' => []); + $foo->add_symbol('%hash_init' => {}); + $foo->add_symbol('&code_init' => sub { "foo" }); + $foo->add_symbol('io_init' => Symbol::geniosym); + } "add_symbol doesn't leak"; is(exception { is(Foo->code_init, 'foo', "sub installed correctly") }, undef, "code_init exists"); @@ -73,60 +73,60 @@ use Symbol; { my $foo = Package::Stash->new('Foo'); no_leaks_ok { - $foo->remove_package_symbol('$scalar_init'); - $foo->remove_package_symbol('@array_init'); - $foo->remove_package_symbol('%hash_init'); - $foo->remove_package_symbol('&code_init'); - $foo->remove_package_symbol('io_init'); - } "remove_package_symbol doesn't leak"; + $foo->remove_symbol('$scalar_init'); + $foo->remove_symbol('@array_init'); + $foo->remove_symbol('%hash_init'); + $foo->remove_symbol('&code_init'); + $foo->remove_symbol('io_init'); + } "remove_symbol doesn't leak"; } { my $foo = Package::Stash->new('Foo'); - $foo->add_package_symbol("${_}glob") for ('$', '@', '%', '&', ''); + $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', ''); no_leaks_ok { - $foo->remove_package_glob('glob'); - } "remove_package_glob doesn't leak"; + $foo->remove_glob('glob'); + } "remove_glob doesn't leak"; } { my $foo = Package::Stash->new('Foo'); no_leaks_ok { - $foo->has_package_symbol('io'); - $foo->has_package_symbol('%hash'); - $foo->has_package_symbol('@array_init'); - $foo->has_package_symbol('$glob'); - $foo->has_package_symbol('&something_else'); - } "has_package_symbol doesn't leak"; + $foo->has_symbol('io'); + $foo->has_symbol('%hash'); + $foo->has_symbol('@array_init'); + $foo->has_symbol('$glob'); + $foo->has_symbol('&something_else'); + } "has_symbol doesn't leak"; } { my $foo = Package::Stash->new('Foo'); no_leaks_ok { - $foo->get_package_symbol('io'); - $foo->get_package_symbol('%hash'); - $foo->get_package_symbol('@array_init'); - $foo->get_package_symbol('$glob'); - $foo->get_package_symbol('&something_else'); - } "get_package_symbol doesn't leak"; + $foo->get_symbol('io'); + $foo->get_symbol('%hash'); + $foo->get_symbol('@array_init'); + $foo->get_symbol('$glob'); + $foo->get_symbol('&something_else'); + } "get_symbol doesn't leak"; } { my $foo = Package::Stash->new('Foo'); - ok(!$foo->has_package_symbol('$glob')); - ok(!$foo->has_package_symbol('@array_init')); + ok(!$foo->has_symbol('$glob')); + ok(!$foo->has_symbol('@array_init')); no_leaks_ok { - $foo->get_or_add_package_symbol('io'); - $foo->get_or_add_package_symbol('%hash'); + $foo->get_or_add_symbol('io'); + $foo->get_or_add_symbol('%hash'); my @super = ('Exporter'); - @{$foo->get_or_add_package_symbol('@ISA')} = @super; - $foo->get_or_add_package_symbol('$glob'); - } "get_or_add_package_symbol doesn't leak"; - ok($foo->has_package_symbol('$glob')); - is(ref($foo->get_package_symbol('$glob')), 'SCALAR'); - ok($foo->has_package_symbol('@ISA')); - is(ref($foo->get_package_symbol('@ISA')), 'ARRAY'); - is_deeply($foo->get_package_symbol('@ISA'), ['Exporter']); + @{$foo->get_or_add_symbol('@ISA')} = @super; + $foo->get_or_add_symbol('$glob'); + } "get_or_add_symbol doesn't leak"; + ok($foo->has_symbol('$glob')); + is(ref($foo->get_symbol('$glob')), 'SCALAR'); + ok($foo->has_symbol('@ISA')); + is(ref($foo->get_symbol('@ISA')), 'ARRAY'); + is_deeply($foo->get_symbol('@ISA'), ['Exporter']); isa_ok('Foo', 'Exporter'); } @@ -134,11 +134,11 @@ use Symbol; my $foo = Package::Stash->new('Foo'); my $baz = Package::Stash->new('Baz'); no_leaks_ok { - $foo->list_all_package_symbols; - $foo->list_all_package_symbols('SCALAR'); - $foo->list_all_package_symbols('CODE'); - $baz->list_all_package_symbols('CODE'); - } "list_all_package_symbols doesn't leak"; + $foo->list_all_symbols; + $foo->list_all_symbols('SCALAR'); + $foo->list_all_symbols('CODE'); + $baz->list_all_symbols('CODE'); + } "list_all_symbols doesn't leak"; } # mimic CMOP::create_anon_class @@ -148,9 +148,9 @@ use Symbol; $i++; eval "package Quux$i; 1;"; my $quux = Package::Stash->new("Quux$i"); - $quux->get_or_add_package_symbol('@ISA'); + $quux->get_or_add_symbol('@ISA'); delete $::{'Quux' . $i . '::'}; - } "get_package_symbol doesn't leak during glob expansion"; + } "get_symbol doesn't leak during glob expansion"; } done_testing; |