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 {
  38  no strict 'refs';
  39  cast %{"Hlagh::"}, $wiz;
  40 }
  41
  42 {
  43  local %mg;
  44
  45  eval q{
  46   die "ok\n";
  47   package Hlagh;
  48   our $a;
  49   {
  50    package NotHlagh;
  51    our $x = @Hlagh::b;
  52   }
  53  };
  54
  55  is $@, "ok\n", 'stash: variables compiled fine';
  56  is_deeply \%mg, {
  57   fetch => [ qw/a b/ ],
  58   store => [ qw/a b/ ],
  59  }, 'stash: variables';
  60 }
  61
  62 {
  63  local %mg;
  64
  65  eval q{
  66   die "ok\n";
  67   package Hlagh;
  68   foo();
  69   bar();
  70   foo();
  71  };
  72
  73  is $@, "ok\n", 'stash: function calls compiled fine';
  74  is_deeply \%mg, {
  75   fetch => [ qw/foo bar foo/ ],
  76   store => [ qw/foo bar foo/ ],
  77  }, 'stash: function calls';
  78 }
  79
  80 {
  81  local %mg;
  82
  83  eval q{
  84   package Hlagh;
  85   undef &foo;
  86  };
  87
  88  is $@, '', 'stash: delete executed fine';
  89  is_deeply \%mg, {
  90   store => [ qw/foo foo foo/ ],
  91  }, 'stash: delete';
  92 }
  93
  94 END {
  95  is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run;
  96 }
  97
  98 {
  99  no strict 'refs';
 100  dispell %{"Hlagh::"}, $wiz;
 101 }
 102
 103 $code = 'wizard '
 104         . join (', ', map { <<CB;
 105 $_ => sub {
 106  my \$d = \$_[1];
 107  return 0 if \$d->{guard};
 108  local \$d->{guard} = 1;
 109  is \$_[3], undef, 'stash: undef op';
 110  ()
 111 }
 112 CB
 113 } qw/fetch store exists delete/);
 114
 115 $code .= ', data => sub { +{ guard => 0 } }';
 116
 117 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
 118 diag $@ if $@;
 119
 120 {
 121  no strict 'refs';
 122  cast %{"Hlagh::"}, $wiz;
 123 }
 124
 125 eval q{
 126  die "ok\n";
 127  package Hlagh;
 128  meh();
 129 };
 130
 131 is $@, "ok\n", 'stash: function call with op name compiled fine';
 132
 133 {
 134  no strict 'refs';
 135  dispell %{"Hlagh::"}, $wiz;
 136 }
 137
 138 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
 139 diag $@ if $@;
 140
 141 {
 142  no strict 'refs';
 143  cast %{"Hlagh::"}, $wiz;
 144 }
 145
 146 eval q{
 147  die "ok\n";
 148  package Hlagh;
 149  wat();
 150 };
 151
 152 is $@, "ok\n", 'stash: function call with op object compiled fine';
 153
 154 {
 155  no strict 'refs';
 156  dispell %{"Hlagh::"}, $wiz;
 157 }