From 988beb418b12b8cc4821055d79361f807c98aa36 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 15 Jun 2010 19:11:16 -0500 Subject: updated dzil stuff --- t/000-load.t | 8 -- t/001-basic.t | 273 ------------------------------------------------------ t/002-extension.t | 70 -------------- t/003-io.t | 50 ---------- t/004-get.t | 66 ------------- t/005-isa.t | 21 ----- t/006-addsub.t | 45 --------- t/01-basic.t | 273 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/010-synopsis.t | 18 ---- t/02-extension.t | 70 ++++++++++++++ t/03-io.t | 50 ++++++++++ t/04-get.t | 66 +++++++++++++ t/05-isa.t | 21 +++++ t/06-addsub.t | 45 +++++++++ t/10-synopsis.t | 18 ++++ 15 files changed, 543 insertions(+), 551 deletions(-) delete mode 100644 t/000-load.t delete mode 100644 t/001-basic.t delete mode 100644 t/002-extension.t delete mode 100644 t/003-io.t delete mode 100644 t/004-get.t delete mode 100644 t/005-isa.t delete mode 100644 t/006-addsub.t create mode 100644 t/01-basic.t delete mode 100644 t/010-synopsis.t create mode 100644 t/02-extension.t create mode 100644 t/03-io.t create mode 100644 t/04-get.t create mode 100644 t/05-isa.t create mode 100644 t/06-addsub.t create mode 100644 t/10-synopsis.t (limited to 't') diff --git a/t/000-load.t b/t/000-load.t deleted file mode 100644 index 0420fe7..0000000 --- a/t/000-load.t +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; - -package Foo; -::use_ok('Package::Stash') - or ::BAIL_OUT("couldn't load Package::Stash"); diff --git a/t/001-basic.t b/t/001-basic.t deleted file mode 100644 index efd82b4..0000000 --- a/t/001-basic.t +++ /dev/null @@ -1,273 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use Test::Exception; - -use Package::Stash; - -dies_ok { Package::Stash->name } q{... can't call name() as a class method}; - -{ - package Foo; - - use constant SOME_CONSTANT => 1; -} - -# ---------------------------------------------------------------------- -## tests adding a HASH - -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(!defined($Foo::{foo}), '... checking doesn\' vivify'); - -lives_ok { - $foo_stash->add_package_symbol('%foo' => { one => 1 }); -} '... 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(defined($Foo::{foo}), '... the %foo slot was created successfully'); -ok($foo_stash->has_package_symbol('%foo'), '... the meta agrees'); - -# check the value ... - -{ - no strict 'refs'; - ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly'); - is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly'); -} - -my $foo = $foo_stash->get_package_symbol('%foo'); -is_deeply({ one => 1 }, $foo, '... got the right package variable back'); - -# ... make sure changes propogate up - -$foo->{two} = 2; - -{ - no strict 'refs'; - is(\%{'Foo::foo'}, $foo_stash->get_package_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'); -} - -# ---------------------------------------------------------------------- -## test adding an ARRAY - -ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); -} '... created @Foo::bar successfully'; - -ok(defined($Foo::{bar}), '... the @bar slot was created successfully'); -ok($foo_stash->has_package_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'); - -# check the value itself - -{ - no strict 'refs'; - is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly'); - is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly'); -} - -# ---------------------------------------------------------------------- -## test adding a SCALAR - -ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('$baz' => 10); -} '... 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_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'); - -is(${$foo_stash->get_package_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'); -} - -# ---------------------------------------------------------------------- -## test adding a CODE - -ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk" }); -} '... 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_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'); - -{ - no strict 'refs'; - ok(defined &{'Foo::funk'}, '... our &funk exists'); -} - -is(Foo->funk(), 'Foo::funk', '... got the right value from the function'); - -# ---------------------------------------------------------------------- -## test multiple slots in the glob - -my $ARRAY = [ 1, 2, 3 ]; -my $CODE = sub { "Foo::foo" }; - -lives_ok { - $foo_stash->add_package_symbol('@foo' => $ARRAY); -} '... 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'); - -lives_ok { - $foo_stash->add_package_symbol('&foo' => $CODE); -} '... 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'); - -lives_ok { - $foo_stash->add_package_symbol('$foo' => 'Foo::foo'); -} '... created $Foo::foo successfully'; - -ok($foo_stash->has_package_symbol('$foo'), '... the meta agrees'); -my $SCALAR = $foo_stash->get_package_symbol('$foo'); -is($$SCALAR, 'Foo::foo', '... got the right scalar value back'); - -{ - no strict 'refs'; - is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar'); -} - -lives_ok { - $foo_stash->remove_package_symbol('%foo'); -} '... 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'); - -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'); - -{ - no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); -} - -lives_ok { - $foo_stash->remove_package_symbol('&foo'); -} '... removed &Foo::foo successfully'; - -ok(!$foo_stash->has_package_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'); - -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'); - -{ - no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); -} - -lives_ok { - $foo_stash->remove_package_symbol('$foo'); -} '... removed $Foo::foo successfully'; - -ok(!$foo_stash->has_package_symbol('$foo'), '... the $foo slot no longer exists'); - -ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot still exists'); - -is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); - -{ - no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); -} - -# check some errors - -dies_ok { - $foo_stash->add_package_symbol('@bar', {}) -} "can't initialize a slot with the wrong type of value"; - -dies_ok { - $foo_stash->add_package_symbol('bar', []) -} "can't initialize a slot with the wrong type of value"; - -dies_ok { - $foo_stash->add_package_symbol('$bar', sub { }) -} "can't initialize a slot with the wrong type of value"; - -{ - package Bar; - open *foo, '<', $0; -} - -dies_ok { - $foo_stash->add_package_symbol('$bar', *Bar::foo{IO}) -} "can't initialize a slot with the wrong type of value"; - -# check compile time manipulation - -{ - package Baz; - - our $foo = 23; - our @foo = "bar"; - our %foo = (baz => 1); - sub foo { } - open *foo, '<', $0; - BEGIN { Package::Stash->new(__PACKAGE__)->remove_package_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"); -} - -done_testing; diff --git a/t/002-extension.t b/t/002-extension.t deleted file mode 100644 index 2f95f15..0000000 --- a/t/002-extension.t +++ /dev/null @@ -1,70 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use Test::Exception; - -{ - package My::Package::Stash; - use strict; - use warnings; - - use base 'Package::Stash'; - - use Symbol 'gensym'; - - sub namespace { - $_[0]->{namespace} ||= {} - } - - sub add_package_symbol { - my ($self, $variable, $initial_value) = @_; - - my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); - - my $glob = gensym(); - *{$glob} = $initial_value if defined $initial_value; - $self->namespace->{$name} = *{$glob}; - } -} - -# No actually package Foo exists :) -my $foo_stash = My::Package::Stash->new('Foo'); - -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'); - -lives_ok { - $foo_stash->add_package_symbol('%foo' => { one => 1 }); -} '... 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'); - -my $foo = $foo_stash->get_package_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'); - -ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); -} '... created @Foo::bar successfully'; - -ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); - -ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('%baz'); -} '... created %Foo::baz successfully'; - -ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); - -done_testing; diff --git a/t/003-io.t b/t/003-io.t deleted file mode 100644 index 43a7dd8..0000000 --- a/t/003-io.t +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Exception; - -{ - package Foo; - open *foo, "<", $0; - - sub foo { } -} - -{ - package Bar; - open *bar, "<", $0; - - sub bar { } -} - -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"); -} - -{ - 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"); -} - -{ - my $stash = Package::Stash->new('Baz'); - lives_ok { - $stash->add_package_symbol('baz', *Foo::foo{IO}); - } "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"); -} - -done_testing; diff --git a/t/004-get.t b/t/004-get.t deleted file mode 100644 index ebeb864..0000000 --- a/t/004-get.t +++ /dev/null @@ -1,66 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -use Package::Stash; - -{ - BEGIN { - my $stash = Package::Stash->new('Foo'); - my $val = $stash->get_package_symbol('%foo'); - is($val, undef, "got nothing yet"); - } - { - no warnings 'void', 'once'; - %Foo::foo; - } - BEGIN { - my $stash = Package::Stash->new('Foo'); - my $val = $stash->get_package_symbol('%foo'); - is(ref($val), 'HASH', "got something"); - $val->{bar} = 1; - is_deeply($stash->get_package_symbol('%foo'), {bar => 1}, - "got the right variable"); - } -} - -{ - BEGIN { - my $stash = Package::Stash->new('Bar'); - my $val = $stash->get_package_symbol('@foo'); - is($val, undef, "got something"); - } - { - no warnings 'void', 'once'; - @Bar::foo; - } - BEGIN { - my $stash = Package::Stash->new('Bar'); - my $val = $stash->get_package_symbol('@foo'); - is(ref($val), 'ARRAY', "got something"); - push @$val, 1; - is_deeply($stash->get_package_symbol('@foo'), [1], - "got the right variable"); - } -} - -{ - my $stash = Package::Stash->new('Baz'); - my $val = $stash->get_or_add_package_symbol('%foo'); - is(ref($val), 'HASH', "got something"); - $val->{bar} = 1; - is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1}, - "got the right variable"); -} - -{ - my $stash = Package::Stash->new('Quux'); - my $val = $stash->get_or_add_package_symbol('@foo'); - is(ref($val), 'ARRAY', "got something"); - push @$val, 1; - is_deeply($stash->get_or_add_package_symbol('@foo'), [1], - "got the right variable"); -} - -done_testing; diff --git a/t/005-isa.t b/t/005-isa.t deleted file mode 100644 index 3198fb1..0000000 --- a/t/005-isa.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -use Package::Stash; - -{ - package Foo; -} - -{ - package Bar; -} - -my $stash = Package::Stash->new('Foo'); -my @ISA = ('Bar'); -@{$stash->get_package_symbol('@ISA')} = @ISA; -isa_ok('Foo', 'Bar'); - -done_testing; diff --git a/t/006-addsub.t b/t/006-addsub.t deleted file mode 100644 index 3c0dfc8..0000000 --- a/t/006-addsub.t +++ /dev/null @@ -1,45 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use Test::Exception; - -BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE - -use Package::Stash; - -my $foo_stash = Package::Stash->new('Foo'); - -# ---------------------------------------------------------------------- -## test adding a CODE - -ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); - -lives_ok { - $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk", __LINE__ }); -} '... created &Foo::funk successfully'; - -ok(defined($Foo::{funk}), '... the &funk slot was created successfully'); - -{ - no strict 'refs'; - ok(defined &{'Foo::funk'}, '... our &funk exists'); -} - -is((Foo->funk())[0], 'Foo::funk', '... got the right value from the function'); - -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( - '&dunk' => sub { "Foo::dunk" }, - filename => "FileName", - first_line_num => 100, - last_line_num => 199 -); - -is $DB::sub{'Foo::dunk'}, sprintf "%s:%d-%d", "FileName", 100, 199, - '... got the right %DB::sub value for dunk with specified args'; - -done_testing; diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100644 index 0000000..efd82b4 --- /dev/null +++ b/t/01-basic.t @@ -0,0 +1,273 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +use Package::Stash; + +dies_ok { Package::Stash->name } q{... can't call name() as a class method}; + +{ + package Foo; + + use constant SOME_CONSTANT => 1; +} + +# ---------------------------------------------------------------------- +## tests adding a HASH + +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(!defined($Foo::{foo}), '... checking doesn\' vivify'); + +lives_ok { + $foo_stash->add_package_symbol('%foo' => { one => 1 }); +} '... 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(defined($Foo::{foo}), '... the %foo slot was created successfully'); +ok($foo_stash->has_package_symbol('%foo'), '... the meta agrees'); + +# check the value ... + +{ + no strict 'refs'; + ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly'); + is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly'); +} + +my $foo = $foo_stash->get_package_symbol('%foo'); +is_deeply({ one => 1 }, $foo, '... got the right package variable back'); + +# ... make sure changes propogate up + +$foo->{two} = 2; + +{ + no strict 'refs'; + is(\%{'Foo::foo'}, $foo_stash->get_package_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'); +} + +# ---------------------------------------------------------------------- +## test adding an ARRAY + +ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); +} '... created @Foo::bar successfully'; + +ok(defined($Foo::{bar}), '... the @bar slot was created successfully'); +ok($foo_stash->has_package_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'); + +# check the value itself + +{ + no strict 'refs'; + is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly'); + is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly'); +} + +# ---------------------------------------------------------------------- +## test adding a SCALAR + +ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('$baz' => 10); +} '... 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_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'); + +is(${$foo_stash->get_package_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'); +} + +# ---------------------------------------------------------------------- +## test adding a CODE + +ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk" }); +} '... 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_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'); + +{ + no strict 'refs'; + ok(defined &{'Foo::funk'}, '... our &funk exists'); +} + +is(Foo->funk(), 'Foo::funk', '... got the right value from the function'); + +# ---------------------------------------------------------------------- +## test multiple slots in the glob + +my $ARRAY = [ 1, 2, 3 ]; +my $CODE = sub { "Foo::foo" }; + +lives_ok { + $foo_stash->add_package_symbol('@foo' => $ARRAY); +} '... 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'); + +lives_ok { + $foo_stash->add_package_symbol('&foo' => $CODE); +} '... 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'); + +lives_ok { + $foo_stash->add_package_symbol('$foo' => 'Foo::foo'); +} '... created $Foo::foo successfully'; + +ok($foo_stash->has_package_symbol('$foo'), '... the meta agrees'); +my $SCALAR = $foo_stash->get_package_symbol('$foo'); +is($$SCALAR, 'Foo::foo', '... got the right scalar value back'); + +{ + no strict 'refs'; + is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar'); +} + +lives_ok { + $foo_stash->remove_package_symbol('%foo'); +} '... 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'); + +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'); + +{ + no strict 'refs'; + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); +} + +lives_ok { + $foo_stash->remove_package_symbol('&foo'); +} '... removed &Foo::foo successfully'; + +ok(!$foo_stash->has_package_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'); + +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'); + +{ + no strict 'refs'; + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); +} + +lives_ok { + $foo_stash->remove_package_symbol('$foo'); +} '... removed $Foo::foo successfully'; + +ok(!$foo_stash->has_package_symbol('$foo'), '... the $foo slot no longer exists'); + +ok($foo_stash->has_package_symbol('@foo'), '... the @foo slot still exists'); + +is($foo_stash->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo'); + +{ + no strict 'refs'; + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); +} + +# check some errors + +dies_ok { + $foo_stash->add_package_symbol('@bar', {}) +} "can't initialize a slot with the wrong type of value"; + +dies_ok { + $foo_stash->add_package_symbol('bar', []) +} "can't initialize a slot with the wrong type of value"; + +dies_ok { + $foo_stash->add_package_symbol('$bar', sub { }) +} "can't initialize a slot with the wrong type of value"; + +{ + package Bar; + open *foo, '<', $0; +} + +dies_ok { + $foo_stash->add_package_symbol('$bar', *Bar::foo{IO}) +} "can't initialize a slot with the wrong type of value"; + +# check compile time manipulation + +{ + package Baz; + + our $foo = 23; + our @foo = "bar"; + our %foo = (baz => 1); + sub foo { } + open *foo, '<', $0; + BEGIN { Package::Stash->new(__PACKAGE__)->remove_package_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"); +} + +done_testing; diff --git a/t/010-synopsis.t b/t/010-synopsis.t deleted file mode 100644 index 4c93f32..0000000 --- a/t/010-synopsis.t +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -use Package::Stash; - -my $stash = Package::Stash->new('Foo'); -$stash->add_package_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"); -my $namespace = $stash->namespace; -is_deeply(*{ $namespace->{foo} }{HASH}, {bar => 1}, "namespace works properly"); - -done_testing; diff --git a/t/02-extension.t b/t/02-extension.t new file mode 100644 index 0000000..2f95f15 --- /dev/null +++ b/t/02-extension.t @@ -0,0 +1,70 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +{ + package My::Package::Stash; + use strict; + use warnings; + + use base 'Package::Stash'; + + use Symbol 'gensym'; + + sub namespace { + $_[0]->{namespace} ||= {} + } + + sub add_package_symbol { + my ($self, $variable, $initial_value) = @_; + + my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); + + my $glob = gensym(); + *{$glob} = $initial_value if defined $initial_value; + $self->namespace->{$name} = *{$glob}; + } +} + +# No actually package Foo exists :) +my $foo_stash = My::Package::Stash->new('Foo'); + +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'); + +lives_ok { + $foo_stash->add_package_symbol('%foo' => { one => 1 }); +} '... 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'); + +my $foo = $foo_stash->get_package_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'); + +ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('@bar' => [ 1, 2, 3 ]); +} '... created @Foo::bar successfully'; + +ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); + +ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('%baz'); +} '... created %Foo::baz successfully'; + +ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); + +done_testing; diff --git a/t/03-io.t b/t/03-io.t new file mode 100644 index 0000000..43a7dd8 --- /dev/null +++ b/t/03-io.t @@ -0,0 +1,50 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; + +{ + package Foo; + open *foo, "<", $0; + + sub foo { } +} + +{ + package Bar; + open *bar, "<", $0; + + sub bar { } +} + +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"); +} + +{ + 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"); +} + +{ + my $stash = Package::Stash->new('Baz'); + lives_ok { + $stash->add_package_symbol('baz', *Foo::foo{IO}); + } "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"); +} + +done_testing; diff --git a/t/04-get.t b/t/04-get.t new file mode 100644 index 0000000..ebeb864 --- /dev/null +++ b/t/04-get.t @@ -0,0 +1,66 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Package::Stash; + +{ + BEGIN { + my $stash = Package::Stash->new('Foo'); + my $val = $stash->get_package_symbol('%foo'); + is($val, undef, "got nothing yet"); + } + { + no warnings 'void', 'once'; + %Foo::foo; + } + BEGIN { + my $stash = Package::Stash->new('Foo'); + my $val = $stash->get_package_symbol('%foo'); + is(ref($val), 'HASH', "got something"); + $val->{bar} = 1; + is_deeply($stash->get_package_symbol('%foo'), {bar => 1}, + "got the right variable"); + } +} + +{ + BEGIN { + my $stash = Package::Stash->new('Bar'); + my $val = $stash->get_package_symbol('@foo'); + is($val, undef, "got something"); + } + { + no warnings 'void', 'once'; + @Bar::foo; + } + BEGIN { + my $stash = Package::Stash->new('Bar'); + my $val = $stash->get_package_symbol('@foo'); + is(ref($val), 'ARRAY', "got something"); + push @$val, 1; + is_deeply($stash->get_package_symbol('@foo'), [1], + "got the right variable"); + } +} + +{ + my $stash = Package::Stash->new('Baz'); + my $val = $stash->get_or_add_package_symbol('%foo'); + is(ref($val), 'HASH', "got something"); + $val->{bar} = 1; + is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1}, + "got the right variable"); +} + +{ + my $stash = Package::Stash->new('Quux'); + my $val = $stash->get_or_add_package_symbol('@foo'); + is(ref($val), 'ARRAY', "got something"); + push @$val, 1; + is_deeply($stash->get_or_add_package_symbol('@foo'), [1], + "got the right variable"); +} + +done_testing; diff --git a/t/05-isa.t b/t/05-isa.t new file mode 100644 index 0000000..3198fb1 --- /dev/null +++ b/t/05-isa.t @@ -0,0 +1,21 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Package::Stash; + +{ + package Foo; +} + +{ + package Bar; +} + +my $stash = Package::Stash->new('Foo'); +my @ISA = ('Bar'); +@{$stash->get_package_symbol('@ISA')} = @ISA; +isa_ok('Foo', 'Bar'); + +done_testing; diff --git a/t/06-addsub.t b/t/06-addsub.t new file mode 100644 index 0000000..3c0dfc8 --- /dev/null +++ b/t/06-addsub.t @@ -0,0 +1,45 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE + +use Package::Stash; + +my $foo_stash = Package::Stash->new('Foo'); + +# ---------------------------------------------------------------------- +## test adding a CODE + +ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet'); + +lives_ok { + $foo_stash->add_package_symbol('&funk' => sub { "Foo::funk", __LINE__ }); +} '... created &Foo::funk successfully'; + +ok(defined($Foo::{funk}), '... the &funk slot was created successfully'); + +{ + no strict 'refs'; + ok(defined &{'Foo::funk'}, '... our &funk exists'); +} + +is((Foo->funk())[0], 'Foo::funk', '... got the right value from the function'); + +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( + '&dunk' => sub { "Foo::dunk" }, + filename => "FileName", + first_line_num => 100, + last_line_num => 199 +); + +is $DB::sub{'Foo::dunk'}, sprintf "%s:%d-%d", "FileName", 100, 199, + '... got the right %DB::sub value for dunk with specified args'; + +done_testing; diff --git a/t/10-synopsis.t b/t/10-synopsis.t new file mode 100644 index 0000000..4c93f32 --- /dev/null +++ b/t/10-synopsis.t @@ -0,0 +1,18 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Package::Stash; + +my $stash = Package::Stash->new('Foo'); +$stash->add_package_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"); +my $namespace = $stash->namespace; +is_deeply(*{ $namespace->{foo} }{HASH}, {bar => 1}, "namespace works properly"); + +done_testing; -- cgit v1.2.3-54-g00ecf