6 use Test::More tests => 30;
8 use Variable::Magic qw/wizard getsig cast dispell SIG_MIN SIG_MAX/;
12 my ($a, $b, $c, $d) = 1 .. 4;
14 my $inv_num_sig = qr/Invalid\s+numeric\s+signature\s+at\s+\Q$0\E/;
17 my $wiz = eval { wizard sig => $sig };
18 is($@, '', 'wizard creation doesn\'t croak');
19 ok(defined $wiz, 'wizard is defined');
20 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
21 is($sig, getsig $wiz, 'wizard signature is correct');
23 my $wiz2 = eval { wizard sig => $sig };
24 is($@, '', 'wizard retreive doesn\'t croak');
25 ok(defined $wiz2, 'retrieved wizard is defined');
26 is(ref $wiz2, 'SCALAR', 'retrieved wizard is a scalar ref');
27 is($sig, getsig $wiz2, 'retrieved wizard signature is correct');
29 my $wiz3 = eval { wizard sig => [ ] };
30 like($@, $inv_num_sig, 'non numeric signature croaks');
31 is($wiz3, undef, 'non numeric signature doesn\'t return anything');
33 $wiz3 = eval { wizard sig => SIG_MIN - 1 };
34 like($@, $inv_num_sig, 'numeric signature too small croaks');
35 is($wiz3, undef, 'numeric signature too small doesn\'t return anything');
37 $wiz3 = eval { wizard sig => SIG_MAX + 1 };
38 like($@, $inv_num_sig, 'numeric signature too big croaks');
39 is($wiz3, undef, 'numeric signature too big doesn\'t return anything');
42 my $res = eval { cast $a, $wiz };
43 is($@, '', 'cast from wizard doesn\'t croak');
44 ok($res, 'cast from wizard invalid');
46 $res = eval { dispell $a, $wiz2 };
47 is($@, '', 'dispell from retrieved wizard doesn\'t croak');
48 ok($res, 'dispell from retrieved wizard invalid');
50 $res = eval { cast $b, $sig };
51 is($@, '', 'cast from integer doesn\'t croak');
52 ok($res, 'cast from integer invalid');
55 my $res = eval { cast $c, $sig + 0.1 };
56 is($@, '', 'cast from float doesn\'t croak');
57 ok($res, 'cast from float invalid');
59 $res = eval { cast $d, sprintf "%u", $sig };
60 is($@, '', 'cast from string doesn\'t croak');
61 ok($res, 'cast from string invalid');
63 $res = eval { dispell $b, $sig };
64 is($@, '', 'dispell from integer doesn\'t croak');
65 ok($res, 'dispell from integer invalid');
67 $res = eval { dispell $c, $sig + 0.1 };
68 is($@, '', 'dispell from float doesn\'t croak');
69 ok($res, 'dispell from float invalid');
71 $res = eval { dispell $d, sprintf "%u", $sig };
72 is($@, '', 'dispell from string doesn\'t croak');
73 ok($res, 'dispell from string invalid');