From: Vincent Pit Date: Mon, 9 Feb 2009 17:20:54 +0000 (+0100) Subject: Test magic on symbol table in a new t/35-stash.t X-Git-Tag: v0.30~5 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=6481de87d7fb6fe3a3308704ed6d75dd78aa1e22;p=perl%2Fmodules%2FVariable-Magic.git Test magic on symbol table in a new t/35-stash.t --- diff --git a/MANIFEST b/MANIFEST index fc83fa8..23e7eef 100644 --- a/MANIFEST +++ b/MANIFEST @@ -32,6 +32,7 @@ t/31-array.t t/32-hash.t t/33-code.t t/34-glob.t +t/35-stash.t t/40-threads.t t/41-clone.t t/90-boilerplate.t diff --git a/t/35-stash.t b/t/35-stash.t new file mode 100644 index 0000000..54c6b16 --- /dev/null +++ b/t/35-stash.t @@ -0,0 +1,157 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +use Variable::Magic qw/wizard cast dispell VMG_UVAR/; + +my $run; +if (VMG_UVAR) { + plan tests => 13; + $run = 1; +} else { + plan skip_all => 'uvar magic is required to test symbol table hooks'; +} + +our %mg; + +my $code = 'wizard ' + . join (', ', map { < sub { + my \$d = \$_[1]; + return 0 if \$d->{guard}; + local \$d->{guard} = 1; + push \@{\$mg{$_}}, \$_[2]; + () +} +CB +} qw/fetch store exists delete/); + +$code .= ', data => sub { +{ guard => 0 } }'; + +my $wiz = eval $code; +diag $@ if $@; + +{ + no strict 'refs'; + cast %{"Hlagh::"}, $wiz; +} + +{ + local %mg; + + eval q{ + die "ok\n"; + package Hlagh; + our $a; + { + package NotHlagh; + my $x = @Hlagh::b; + } + }; + + is $@, "ok\n", 'stash: variables compiled fine'; + is_deeply \%mg, { + fetch => [ qw/a b/ ], + store => [ qw/a b/ ], + }, 'stash: variables'; +} + +{ + local %mg; + + eval q{ + die "ok\n"; + package Hlagh; + foo(); + bar(); + foo(); + }; + + is $@, "ok\n", 'stash: function calls compiled fine'; + is_deeply \%mg, { + fetch => [ qw/foo bar foo/ ], + store => [ qw/foo bar foo/ ], + }, 'stash: function calls'; +} + +{ + local %mg; + + eval q{ + package Hlagh; + undef &foo; + }; + + is $@, '', 'stash: delete executed fine'; + is_deeply \%mg, { + store => [ qw/foo foo foo/ ], + }, 'stash: delete'; +} + +END { + is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run; +} + +{ + no strict 'refs'; + dispell %{"Hlagh::"}, $wiz; +} + +$code = 'wizard ' + . join (', ', map { < sub { + my \$d = \$_[1]; + return 0 if \$d->{guard}; + local \$d->{guard} = 1; + is \$_[3], undef, 'stash: undef op'; + () +} +CB +} qw/fetch store exists delete/); + +$code .= ', data => sub { +{ guard => 0 } }'; + +$wiz = eval $code . ', op_info => 1'; +diag $@ if $@; + +{ + no strict 'refs'; + cast %{"Hlagh::"}, $wiz; +} + +eval q{ + die "ok\n"; + package Hlagh; + meh(); +}; + +is $@, "ok\n", 'stash: function call with op_info 1 compiled fine'; + +{ + no strict 'refs'; + dispell %{"Hlagh::"}, $wiz; +} + +$wiz = eval $code . ', op_info => 2'; +diag $@ if $@; + +{ + no strict 'refs'; + cast %{"Hlagh::"}, $wiz; +} + +eval q{ + die "ok\n"; + package Hlagh; + wat(); +}; + +is $@, "ok\n", 'stash: function call with op_info 2 compiled fine'; + +{ + no strict 'refs'; + dispell %{"Hlagh::"}, $wiz; +}