Test repeated method calls on stashes

[perl/modules/Variable-Magic.git] / t / 35-stash.t

diff --git a/t/35-stash.t b/t/35-stash.t
index 13336f7c4cfb042f972ef42e56b60154f6ee6d9d..93bd62c2824c7f2eed9c284bcb85a80f6d8c22bf 100644 (file)
--- a/t/35-stash.t
+++ b/t/35-stash.t
@@ -9,7 +9,7 @@ use Variable::Magic qw/wizard cast dispell VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO
 
 my $run;
 if (VMG_UVAR) {
- plan tests => 13;
+ plan tests => 41;
  $run = 1;
 } else {
  plan skip_all => 'uvar magic is required to test symbol table hooks';
@@ -34,10 +34,7 @@ $code .= ', data => sub { +{ guard => 0 } }';
 my $wiz = eval $code;
 diag $@ if $@;
 
-{
- no strict 'refs';
- cast %{"Hlagh::"}, $wiz;
-}
+cast %Hlagh::, $wiz;
 
 {
  local %mg;
@@ -45,49 +42,186 @@ diag $@ if $@;
  eval q{
   die "ok\n";
   package Hlagh;
-  our $a;
+  our $thing;
   {
    package NotHlagh;
-   my $x = @Hlagh::b;
+   our $what = @Hlagh::stuff;
   }
  };
 
  is $@, "ok\n", 'stash: variables compiled fine';
  is_deeply \%mg, {
-  fetch => [ qw/a b/ ],
-  store => [ qw/a b/ ],
+  fetch => [ qw/thing stuff/ ],
+  store => [ qw/thing stuff/ ],
  }, 'stash: variables';
 }
 
+{
+ local %mg;
+
+ eval q[
+  die "ok\n";
+  package Hlagh;
+  sub eat;
+  sub shoot;
+  sub leave { "bye" };
+  sub shoot { "bang" };
+ ];
+
+ is $@, "ok\n", 'stash: function definitions compiled fine';
+ is_deeply \%mg, {
+  store => [ qw/eat shoot leave shoot/ ],
+ }, 'stash: function definitions';
+}
+
 {
  local %mg;
 
  eval q{
   die "ok\n";
   package Hlagh;
-  foo();
-  bar();
-  foo();
+  eat();
+  shoot();
+  leave();
+  roam();
+  yawn();
+  roam();
  };
 
  is $@, "ok\n", 'stash: function calls compiled fine';
  is_deeply \%mg, {
-  fetch => [ qw/foo bar foo/ ],
-  store => [ qw/foo bar foo/ ],
+  fetch => [ qw/eat shoot leave roam yawn roam/ ],
+  store => [ qw/eat shoot leave roam yawn roam/ ],
  }, 'stash: function calls';
 }
 
+{
+ local %mg;
+
+ eval q{ Hlagh->shoot() };
+
+ is $@, '', 'stash: valid method call ran fine';
+ is_deeply \%mg, {
+  fetch => [ qw/shoot/ ],
+ }, 'stash: valid method call';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagh->shoot() };
+
+ is $@, '', 'stash: second valid method call ran fine';
+ is_deeply \%mg, {
+  fetch => [ qw/shoot/ ],
+ }, 'stash: second valid method call';
+}
+
+{
+ local %mg;
+
+ eval q{ my $meth = 'shoot'; Hlagh->$meth() };
+
+ is $@, '', 'stash: valid dynamic method call ran fine';
+ is_deeply \%mg, {
+  store => [ qw/shoot/ ],
+ }, 'stash: valid dynamic method call';
+}
+
+{
+ local %mg;
+
+ eval q[
+  package Hlagher;
+  our @ISA;
+  BEGIN { @ISA = 'Hlagh' }
+  Hlagher->leave()
+ ];
+
+ is $@, '', 'inherited valid method call ran fine';
+ is_deeply \%mg, {
+  fetch => [ qw/ISA leave/ ],
+ }, 'stash: inherited valid method call';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagher->leave() };
+
+ is $@, '', 'second inherited valid method call ran fine';
+ is_deeply \%mg, { }, 'stash: second inherited valid method call doesn\'t call magic';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagher->shoot() };
+
+ is $@, '', 'inherited previously called valid method call ran fine';
+ is_deeply \%mg, {
+  fetch => [ qw/shoot/ ],
+ }, 'stash: inherited previously called valid method call';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagher->shoot() };
+
+ is $@, '', 'second inherited previously called valid method call ran fine';
+ is_deeply \%mg, { }, 'stash: second inherited previously called valid method call doesn\'t call magic';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagh->unknown() };
+
+ like $@, qr/^Can't locate object method "unknown" via package "Hlagh"/, 'stash: invalid method call croaked';
+ is_deeply \%mg, {
+  fetch => [ qw/unknown/ ],
+  store => [ qw/unknown AUTOLOAD/ ],
+ }, 'stash: invalid method call';
+}
+
+{
+ local %mg;
+
+ eval q{ my $meth = 'unknown_too'; Hlagh->$meth() };
+
+ like $@, qr/^Can't locate object method "unknown_too" via package "Hlagh"/, 'stash: invalid dynamic method call croaked';
+ is_deeply \%mg, {
+  store => [ qw/unknown_too AUTOLOAD/ ],
+ }, 'stash: invalid dynamic method call';
+}
+
+{
+ local %mg;
+
+ eval q{ Hlagher->also_unknown() };
+
+ like $@, qr/^Can't locate object method "also_unknown" via package "Hlagher"/, 'stash: invalid inherited method call croaked';
+ is_deeply \%mg, {
+  fetch => [ qw/also_unknown AUTOLOAD/ ],
+ }, 'stash: invalid method call';
+}
+
 {
  local %mg;
 
  eval q{
   package Hlagh;
-  undef &foo;
+  undef &nevermentioned;
+  undef &eat;
+  undef &shoot;
  };
 
  is $@, '', 'stash: delete executed fine';
  is_deeply \%mg, {
-  store => [ qw/foo foo foo/ ],
+  store => [
+   qw/nevermentioned nevermentioned eat eat shoot shoot nevermentioned/
+  ],
  }, 'stash: delete';
 }
 
@@ -95,11 +229,55 @@ END {
  is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run;
 }
 
+dispell %Hlagh::, $wiz;
+
 {
- no strict 'refs';
- dispell %{"Hlagh::"}, $wiz;
+ package AutoHlagh;
+
+ use vars qw/$AUTOLOAD/;
+
+ sub AUTOLOAD { return $AUTOLOAD }
 }
 
+cast %AutoHlagh::, $wiz;
+
+{
+ local %mg;
+
+ my $res = eval q{ AutoHlagh->autoloaded() };
+
+ is $@,   '',          'stash: autoloaded method call ran fine';
+ is $res, 'AutoHlagh::autoloaded',
+                       'stash: autoloaded method call returned the right thing';
+ is_deeply \%mg, {
+  fetch => [ qw/autoloaded/ ],
+  store => [ qw/autoloaded AUTOLOAD AUTOLOAD/ ],
+ }, 'stash: autoloaded method call';
+}
+
+{
+ package AutoHlagher;
+
+ our @ISA;
+ BEGIN { @ISA = ('AutoHlagh') }
+}
+
+{
+ local %mg;
+
+ my $res = eval q{ AutoHlagher->also_autoloaded() };
+
+ is $@,   '',     'stash: inherited autoloaded method call ran fine';
+ is $res, 'AutoHlagher::also_autoloaded',
+                  'stash: inherited autoloaded method returned the right thing';
+ is_deeply \%mg, {
+  fetch => [ qw/also_autoloaded AUTOLOAD/ ],
+  store => [ qw/AUTOLOAD/ ],
+ }, 'stash: inherited autoloaded method call';
+}
+
+dispell %AutoHlagh::, $wiz;
+
 $code = 'wizard '
         . join (', ', map { <<CB;
 $_ => sub {
@@ -117,10 +295,7 @@ $code .= ', data => sub { +{ guard => 0 } }';
 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
 diag $@ if $@;
 
-{
- no strict 'refs';
- cast %{"Hlagh::"}, $wiz;
-}
+cast %Hlagh::, $wiz;
 
 eval q{
  die "ok\n";
@@ -130,18 +305,12 @@ eval q{
 
 is $@, "ok\n", 'stash: function call with op name compiled fine';
 
-{
- no strict 'refs';
- dispell %{"Hlagh::"}, $wiz;
-}
+dispell %Hlagh::, $wiz;
 
 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
 diag $@ if $@;
 
-{
- no strict 'refs';
- cast %{"Hlagh::"}, $wiz;
-}
+cast %Hlagh::, $wiz;
 
 eval q{
  die "ok\n";
@@ -151,7 +320,4 @@ eval q{
 
 is $@, "ok\n", 'stash: function call with op object compiled fine';
 
-{
- no strict 'refs';
- dispell %{"Hlagh::"}, $wiz;
-}
+dispell %Hlagh::, $wiz;