X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F17-ctl.t;h=a7557aeb6567ecc6e6497071bf657bf199651c33;hb=90ca07f2bcc731f8a3118fecdfffbd8975686eaa;hp=e694a16b244f10c997d405a410d1816904d9818c;hpb=47e2d1bc5fd0a815679af42924899c1a56d41c23;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/t/17-ctl.t b/t/17-ctl.t
index e694a16..a7557ae 100644
--- a/t/17-ctl.t
+++ b/t/17-ctl.t
@@ -3,20 +3,88 @@
 use strict;
 use warnings;
 
-use Test::More tests => 1;
+use Test::More tests => 10 + 1;
 
-use Variable::Magic qw/wizard cast getdata/;
+use Variable::Magic qw/wizard cast/;
+
+my $wiz;
+
+eval {
+ $wiz = wizard data => sub { $_[1]->() };
+ my $x;
+ cast $x, $wiz, sub { die "carrot" };
+};
+
+like $@, qr/carrot/, 'die in data callback';
+
+eval {
+ $wiz = wizard data => sub { $_[1] },
+               set  => sub { $_[1]->(); () };
+ my $x;
+ cast $x, $wiz, sub { die "lettuce" };
+ $x = 5;
+};
+
+like $@, qr/lettuce/, 'die in set callback';
+
+my $res = eval {
+ $wiz = wizard data => sub { $_[1] },
+               len  => sub { $_[1]->(); () };
+ my @a = (1 .. 3);
+ cast @a, $wiz, sub { die "potato" };
+ @a;
+};
+
+like $@, qr/potato/, 'die in len callback';
+
+eval {
+ $wiz = wizard data => sub { $_[1] },
+               free => sub { $_[1]->(); () };
+ my $x;
+ cast $x, $wiz, sub { die "spinach" };
+};
+
+like $@, qr/spinach/, 'die in free callback';
 
 # Inspired by B::Hooks::EndOfScope
-# This test is better be left at the beginning of the file, since problems
-# happen at UNITCHECK time
 
-my $wiz;
+eval q{BEGIN {
+ $wiz = wizard data => sub { $_[1]->() };
+ my $x;
+ cast $x, $wiz, sub { die "pumpkin" };
+}};
+
+like $@, qr/pumpkin/, 'die in data callback in BEGIN';
 
-BEGIN {
- $wiz = wizard data => sub { $_[1] }, free => sub { $_[1]->(); () };
+eval q{BEGIN {
+ $wiz = wizard data => sub { $_[1] },
+               free => sub { $_[1]->(); () };
  $^H |= 0x020000;
- cast %^H, $wiz, sub { die "harmless" };
-}
+ cast %^H, $wiz, sub { die "macaroni" };
+}};
+
+like $@, qr/macaroni/, 'die in free callback in BEGIN';
+
+eval q{BEGIN {
+ $wiz = wizard data => sub { $_[1] },
+               len  => sub { $_[1]->(); $_[2] },
+               free => sub { my $x = @{$_[0]}; () };
+ my @a = (1 .. 5);
+ cast @a, $wiz, sub { die "pepperoni" };
+}};
+
+like $@, qr/pepperoni/, 'die in len callback in BEGIN';
+
+use lib 't/lib';
+eval "use Variable::Magic::TestScopeEnd";
+
+like $@, qr/turnip/, 'die in BEGIN in require triggers hints hash destructor';
+
+eval q{BEGIN {
+ Variable::Magic::TestScopeEnd::hook {
+  pass 'in hints hash destructor 2';
+ };
+ die "tomato";
+}};
 
-pass 'die in free callback in BEGIN didn\'t segfault';
+like $@, qr/tomato/, 'die in BEGIN in eval triggers hints hash destructor';