t/35-stash.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Variable::Magic qw/wizard cast dispell VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/;
   9
  10 my $run;
  11 if (VMG_UVAR) {
  12  plan tests => 13;
  13  $run = 1;
  14 } else {
  15  plan skip_all => 'uvar magic is required to test symbol table hooks';
  16 }
  17
  18 our %mg;
  19
  20 my $code = 'wizard '
  21         . join (', ', map { <<CB;
  22 $_ => sub {
  23  my \$d = \$_[1];
  24  return 0 if \$d->{guard};
  25  local \$d->{guard} = 1;
  26  push \@{\$mg{$_}}, \$_[2];
  27  ()
  28 }
  29 CB
  30 } qw/fetch store exists delete/);
  31
  32 $code .= ', data => sub { +{ guard => 0 } }';
  33
  34 my $wiz = eval $code;
  35 diag $@ if $@;
  36
  37 cast %Hlagh::, $wiz;
  38
  39 {
  40  local %mg;
  41
  42  eval q{
  43   die "ok\n";
  44   package Hlagh;
  45   our $a;
  46   {
  47    package NotHlagh;
  48    our $x = @Hlagh::b;
  49   }
  50  };
  51
  52  is $@, "ok\n", 'stash: variables compiled fine';
  53  is_deeply \%mg, {
  54   fetch => [ qw/a b/ ],
  55   store => [ qw/a b/ ],
  56  }, 'stash: variables';
  57 }
  58
  59 {
  60  local %mg;
  61
  62  eval q{
  63   die "ok\n";
  64   package Hlagh;
  65   foo();
  66   bar();
  67   foo();
  68  };
  69
  70  is $@, "ok\n", 'stash: function calls compiled fine';
  71  is_deeply \%mg, {
  72   fetch => [ qw/foo bar foo/ ],
  73   store => [ qw/foo bar foo/ ],
  74  }, 'stash: function calls';
  75 }
  76
  77 {
  78  local %mg;
  79
  80  eval q{
  81   package Hlagh;
  82   undef &foo;
  83  };
  84
  85  is $@, '', 'stash: delete executed fine';
  86  is_deeply \%mg, {
  87   store => [ qw/foo foo foo/ ],
  88  }, 'stash: delete';
  89 }
  90
  91 END {
  92  is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run;
  93 }
  94
  95 dispell %Hlagh::, $wiz;
  96
  97 $code = 'wizard '
  98         . join (', ', map { <<CB;
  99 $_ => sub {
 100  my \$d = \$_[1];
 101  return 0 if \$d->{guard};
 102  local \$d->{guard} = 1;
 103  is \$_[3], undef, 'stash: undef op';
 104  ()
 105 }
 106 CB
 107 } qw/fetch store exists delete/);
 108
 109 $code .= ', data => sub { +{ guard => 0 } }';
 110
 111 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
 112 diag $@ if $@;
 113
 114 cast %Hlagh::, $wiz;
 115
 116 eval q{
 117  die "ok\n";
 118  package Hlagh;
 119  meh();
 120 };
 121
 122 is $@, "ok\n", 'stash: function call with op name compiled fine';
 123
 124 dispell %Hlagh::, $wiz;
 125
 126 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
 127 diag $@ if $@;
 128
 129 cast %Hlagh::, $wiz;
 130
 131 eval q{
 132  die "ok\n";
 133  package Hlagh;
 134  wat();
 135 };
 136
 137 is $@, "ok\n", 'stash: function call with op object compiled fine';
 138
 139 dispell %Hlagh::, $wiz;