]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/17-ctl.t
More tests for t/31-array.t
[perl/modules/Variable-Magic.git] / 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';