From 4ada57e0b39192a0002ff703b7af0f3bd99003fa Mon Sep 17 00:00:00 2001 From: Tim Bunce Date: Sun, 30 May 2010 15:24:59 +0100 Subject: Extend add_package_symbol to set %DB::sub if appropriate. Helps NYTProf and debuggers. --- t/006-addsub.t | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 t/006-addsub.t (limited to 't') diff --git a/t/006-addsub.t b/t/006-addsub.t new file mode 100644 index 0000000..b5a5822 --- /dev/null +++ b/t/006-addsub.t @@ -0,0 +1,40 @@ +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", 100, 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; -- cgit v1.2.3-54-g00ecf