]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blobdiff - t/35-stash.t
5.13.2 calls get magic on globs
[perl/modules/Variable-Magic.git] / t / 35-stash.t
index 43155eb200fddee3957cd62edb5ee62367be096b..6be01aa550eaf7b339b82cf1d4beeb5c0e062b1f 100644 (file)
@@ -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 => 33;
+ plan tests => 43;
  $run = 1;
 } else {
  plan skip_all => 'uvar magic is required to test symbol table hooks';
@@ -88,10 +88,12 @@ cast %Hlagh::, $wiz;
   roam();
  };
 
+ my @calls = qw/eat shoot leave roam yawn roam/;
+
  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 => \@calls,
+  store => ($] < 5.011002 ? \@calls : [ map { ($_) x 2 } @calls ]),
  }, 'stash: function calls';
 }
 
@@ -106,6 +108,17 @@ cast %Hlagh::, $wiz;
  }, '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;
 
@@ -124,15 +137,44 @@ 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/ ],
+  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;
 
@@ -238,18 +280,21 @@ cast %AutoHlagh::, $wiz;
 
 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/);
 
+my $uo_exp = $] < 5.011002 ? 2 : 3;
+
 $code .= ', data => sub { +{ guard => 0 } }';
 
 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
@@ -257,27 +302,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';