From: Vincent Pit <vince@profvince.com>
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 { <<CB;
+$_ => 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 { <<CB;
+$_ => 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;
+}