X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F35-stash.t;h=9d094ea57d3e2cbbcc3096e89d97675160c2b19c;hb=31d52b17;hp=f52dd321d853117c380ab6ea2887cf13716bfa58;hpb=9b7797a4ab8973bc710e348cc19fad264c58e452;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/t/35-stash.t b/t/35-stash.t
index f52dd32..9d094ea 100644
--- a/t/35-stash.t
+++ b/t/35-stash.t
@@ -5,11 +5,14 @@ use warnings;
 
 use Test::More;
 
-use Variable::Magic qw/wizard cast dispell VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/;
+use Variable::Magic qw<
+ wizard cast dispell
+ VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT
+>;
 
 my $run;
 if (VMG_UVAR) {
- plan tests => 29;
+ plan tests => 43;
  $run = 1;
 } else {
  plan skip_all => 'uvar magic is required to test symbol table hooks';
@@ -27,7 +30,7 @@ $_ => sub {
  ()
 }
 CB
-} qw/fetch store exists delete/);
+} qw<fetch store exists delete>);
 
 $code .= ', data => sub { +{ guard => 0 } }';
 
@@ -51,8 +54,8 @@ cast %Hlagh::, $wiz;
 
  is $@, "ok\n", 'stash: variables compiled fine';
  is_deeply \%mg, {
-  fetch => [ qw/thing stuff/ ],
-  store => [ qw/thing stuff/ ],
+  fetch => [ qw<thing stuff> ],
+  store => [ qw<thing stuff> ],
  }, 'stash: variables';
 }
 
@@ -70,7 +73,7 @@ cast %Hlagh::, $wiz;
 
  is $@, "ok\n", 'stash: function definitions compiled fine';
  is_deeply \%mg, {
-  store => [ qw/eat shoot leave shoot/ ],
+  store => [ qw<eat shoot leave shoot> ],
  }, 'stash: function definitions';
 }
 
@@ -88,10 +91,23 @@ cast %Hlagh::, $wiz;
   roam();
  };
 
+ my @calls = qw<eat shoot leave roam yawn roam>;
+ my (@fetch, @store);
+ if ("$]" < 5.011_002) {
+  @fetch = @calls;
+  @store = @calls;
+ } elsif ("$]" < 5.021_004) {
+  @fetch = @calls;
+  @store = map { ($_) x 2 } @calls;
+ } else {
+  @fetch = map { ($_) x 2 } @calls;
+  @store = @calls;
+ }
+
  is $@, "ok\n", 'stash: function calls compiled fine';
  is_deeply \%mg, {
-  fetch => [ qw/eat shoot leave roam yawn roam/ ],
-  store => [ qw/eat shoot leave roam yawn roam/ ],
+  fetch => \@fetch,
+  store => \@store,
  }, 'stash: function calls';
 }
 
@@ -102,10 +118,32 @@ cast %Hlagh::, $wiz;
 
  is $@, '', 'stash: valid method call ran fine';
  is_deeply \%mg, {
-  fetch => [ qw/shoot/ ],
+  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;
 
@@ -113,13 +151,42 @@ cast %Hlagh::, $wiz;
   package Hlagher;
   our @ISA;
   BEGIN { @ISA = 'Hlagh' }
-  Hlagher->shoot()
+  Hlagher->leave()
  ];
 
  is $@, '', 'inherited valid method call ran fine';
  is_deeply \%mg, {
-  fetch => [ qw/ISA shoot/ ],
- }, 'stash: direct method call';
+  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';
 }
 
 {
@@ -129,11 +196,22 @@ cast %Hlagh::, $wiz;
 
  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/ ],
+  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;
 
@@ -141,13 +219,17 @@ cast %Hlagh::, $wiz;
 
  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/ ],
+  fetch => [ qw<also_unknown AUTOLOAD> ],
  }, 'stash: invalid method call';
 }
 
 {
  local %mg;
 
+ my @expected_stores = qw<nevermentioned eat shoot>;
+ @expected_stores    = map { ($_) x 2 } @expected_stores if "$]" < 5.017_004;
+ push @expected_stores, 'nevermentioned'                 if "$]" < 5.017_001;
+
  eval q{
   package Hlagh;
   undef &nevermentioned;
@@ -156,11 +238,7 @@ cast %Hlagh::, $wiz;
  };
 
  is $@, '', 'stash: delete executed fine';
- is_deeply \%mg, {
-  store => [
-   qw/nevermentioned nevermentioned eat eat shoot shoot nevermentioned/
-  ],
- }, 'stash: delete';
+ is_deeply \%mg, { store => \@expected_stores }, 'stash: delete';
 }
 
 END {
@@ -172,7 +250,7 @@ dispell %Hlagh::, $wiz;
 {
  package AutoHlagh;
 
- use vars qw/$AUTOLOAD/;
+ use vars qw<$AUTOLOAD>;
 
  sub AUTOLOAD { return $AUTOLOAD }
 }
@@ -188,8 +266,8 @@ cast %AutoHlagh::, $wiz;
  is $res, 'AutoHlagh::autoloaded',
                        'stash: autoloaded method call returned the right thing';
  is_deeply \%mg, {
-  fetch => [ qw/autoloaded/ ],
-  store => [ qw/autoloaded AUTOLOAD AUTOLOAD/ ],
+  fetch => [ qw<autoloaded> ],
+  store => [ qw<autoloaded AUTOLOAD AUTOLOAD> ],
  }, 'stash: autoloaded method call';
 }
 
@@ -209,24 +287,27 @@ cast %AutoHlagh::, $wiz;
  is $res, 'AutoHlagher::also_autoloaded',
                   'stash: inherited autoloaded method returned the right thing';
  is_deeply \%mg, {
-  fetch => [ qw/also_autoloaded AUTOLOAD/ ],
-  store => [ qw/AUTOLOAD/ ],
+  fetch => [ qw<also_autoloaded AUTOLOAD> ],
+  store => [ qw<AUTOLOAD> ],
  }, 'stash: inherited autoloaded method call';
 }
 
 dispell %AutoHlagh::, $wiz;
 
+my $uo = 0;
 $code = 'wizard '
         . join (', ', map { <<CB;
 $_ => sub {
  my \$d = \$_[1];
  return 0 if \$d->{guard};
  local \$d->{guard} = 1;
- is \$_[3], undef, 'stash: undef op';
+ ++\$uo;
  ()
 }
 CB
-} qw/fetch store exists delete/);
+} qw<fetch store exists delete>);
+
+my $uo_exp = "$]" < 5.011_002 ? 2 : 3;
 
 $code .= ', data => sub { +{ guard => 0 } }';
 
@@ -235,27 +316,35 @@ diag $@ if $@;
 
 cast %Hlagh::, $wiz;
 
+is $uo, 0, 'stash: no undef op before function call with op name';
 eval q{
  die "ok\n";
  package Hlagh;
  meh();
 };
-
-is $@, "ok\n", 'stash: function call with op name compiled fine';
+is $@,  "ok\n",  'stash: function call with op name compiled fine';
+is $uo, $uo_exp, 'stash: undef op after function call with op name';
 
 dispell %Hlagh::, $wiz;
+is $uo, $uo_exp, 'stash: undef op after dispell for function call with op name';
+
+$uo = 0;
 
 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
 diag $@ if $@;
 
 cast %Hlagh::, $wiz;
 
+is $uo, 0, 'stash: no undef op before function call with op object';
 eval q{
  die "ok\n";
  package Hlagh;
  wat();
 };
-
-is $@, "ok\n", 'stash: function call with op object compiled fine';
+is $@,        "ok\n", 'stash: function call with op object compiled fine';
+is $uo, $uo_exp,
+               'stash: undef op after dispell for function call with op object';
 
 dispell %Hlagh::, $wiz;
+is $uo, $uo_exp,
+               'stash: undef op after dispell for function call with op object';