X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F13-sig.t;fp=t%2F13-sig.t;h=c7b9f498d712af21dd9b639a5f811c4c32b2030c;hb=8556481280524737222300317146a23b801f6be0;hp=0000000000000000000000000000000000000000;hpb=ad7c749baf8ebc2ff3e49d44b414f67f13f4ebf2;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/13-sig.t b/t/13-sig.t new file mode 100644 index 0000000..c7b9f49 --- /dev/null +++ b/t/13-sig.t @@ -0,0 +1,57 @@ +#!perl -T + +use Test::More tests => 24; + +use Variable::Magic qw/wizard getsig cast dispell SIG_MIN/; + +my $sig = 300; + +my ($a, $b, $c, $d) = 1 .. 4; + +{ + my $wiz = eval { wizard sig => $sig }; + ok(!$@, "wizard creation error ($@)"); + ok(defined $wiz, 'wizard is defined'); + ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref'); + ok($sig == getsig $wiz, 'wizard signature is correct'); + + my $wiz2 = eval { wizard sig => $sig }; + ok(!$@, "wizard retrieve error ($@)"); + ok(defined $wiz2, 'retrieved wizard is defined'); + ok(ref $wiz2 eq 'SCALAR', 'retrieved wizard is a scalar ref'); + ok($sig == getsig $wiz2, 'retrieved wizard signature is correct'); + + my $a = 1; + my $res = eval { cast $a, $wiz }; + ok(!$@, "cast from wizard croaks ($@)"); + ok($res, 'cast from wizard invalid'); + + $res = eval { dispell $a, $wiz2 }; + ok(!$@, "dispell from retrieved wizard croaks ($@)"); + ok($res, 'dispell from retrieved wizard invalid'); + + $res = eval { cast $b, $sig }; + ok(!$@, "cast from integer croaks ($@)"); + ok($res, 'cast from integer invalid'); +} + +my $res = eval { cast $c, $sig + 0.1 }; +ok(!$@, "cast from float croaks ($@)"); +ok($res, 'cast from float invalid'); + +$res = eval { cast $d, sprintf "%u", $sig }; +ok(!$@, "cast from string croaks ($@)"); +ok($res, 'cast from string invalid'); + +$res = eval { dispell $b, $sig }; +ok(!$@, "dispell from integer croaks ($@)"); +ok($res, 'dispell from integer invalid'); + +$res = eval { dispell $c, $sig + 0.1 }; +ok(!$@, "dispell from float croaks ($@)"); +ok($res, 'dispell from float invalid'); + +$res = eval { dispell $d, sprintf "%u", $sig }; +ok(!$@, "dispell from string croaks ($@)"); +ok($res, 'dispell from string invalid'); +