t/17-ctl.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 7;
   7
   8 use Variable::Magic qw/wizard cast/;
   9
  10 my $wiz;
  11
  12 eval {
  13  $wiz = wizard data => sub { $_[1]->() };
  14  my $x;
  15  cast $x, $wiz, sub { die "carrot" };
  16 };
  17
  18 like $@, qr/carrot/, 'die in data callback';
  19
  20 eval {
  21  $wiz = wizard data => sub { $_[1] },
  22                set  => sub { $_[1]->(); () };
  23  my $x;
  24  cast $x, $wiz, sub { die "lettuce" };
  25  $x = 5;
  26 };
  27
  28 like $@, qr/lettuce/, 'die in set callback';
  29
  30 my $res = eval {
  31  $wiz = wizard data => sub { $_[1] },
  32                len  => sub { $_[1]->(); () };
  33  my @a = (1 .. 3);
  34  cast @a, $wiz, sub { die "potato" };
  35  @a;
  36 };
  37
  38 like $@, qr/potato/, 'die in len callback';
  39
  40 eval {
  41  $wiz = wizard data => sub { $_[1] },
  42                free => sub { $_[1]->(); () };
  43  my $x;
  44  cast $x, $wiz, sub { die "spinach" };
  45 };
  46
  47 like $@, qr/spinach/, 'die in free callback';
  48
  49 # Inspired by B::Hooks::EndOfScope
  50
  51 eval q{BEGIN {
  52  $wiz = wizard data => sub { $_[1]->() };
  53  my $x;
  54  cast $x, $wiz, sub { die "pumpkin" };
  55 }};
  56
  57 like $@, qr/pumpkin/, 'die in data callback in BEGIN';
  58
  59 eval q{BEGIN {
  60  $wiz = wizard data => sub { $_[1] },
  61                free => sub { $_[1]->(); () };
  62  $^H |= 0x020000;
  63  cast %^H, $wiz, sub { die "macaroni" };
  64 }};
  65
  66 like $@, qr/macaroni/, 'die in free callback in BEGIN';
  67
  68 eval q{BEGIN {
  69  $wiz = wizard data => sub { $_[1] },
  70                len  => sub { $_[1]->(); $_[2] },
  71                free => sub { my $x = @{$_[0]}; () };
  72  my @a = (1 .. 5);
  73  cast @a, $wiz, sub { die "pepperoni" };
  74 }};
  75
  76 like $@, qr/pepperoni/, 'die in len callback in BEGIN';