]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blobdiff - t/12-sig.t
Importing Variable-Magic-0.16.tar.gz
[perl/modules/Variable-Magic.git] / t / 12-sig.t
index fa1a34ba45862a0d5b774fc56f6184f04cc2bd68..636ad7e086d17b468ac47c2666c3cd6f6e54865e 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 26;
 
 use Variable::Magic qw/wizard getsig cast dispell SIG_MIN/;
 
@@ -13,48 +13,52 @@ my ($a, $b, $c, $d) = 1 .. 4;
 
 {
  my $wiz = eval { wizard sig => $sig };
ok(!$@, "wizard creation doesn't croak ($@)");
- ok(defined $wiz, 'wizard is defined');
is($@, '',             'wizard creation doesn\'t croak');
+ ok(defined $wiz,       'wizard is defined');
  is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
- is($sig, getsig $wiz, 'wizard signature is correct');
+ is($sig, getsig $wiz,  'wizard signature is correct');
 
  my $wiz2 = eval { wizard sig => $sig };
ok(!$@, "wizard retreive doesn't croak ($@)");
- ok(defined $wiz2, 'retrieved wizard is defined');
is($@, '',              'wizard retreive doesn\'t croak');
+ ok(defined $wiz2,       'retrieved wizard is defined');
  is(ref $wiz2, 'SCALAR', 'retrieved wizard is a scalar ref');
- is($sig, getsig $wiz2, 'retrieved wizard signature is correct');
+ is($sig, getsig $wiz2,  'retrieved wizard signature is correct');
+
+ my $wiz3 = eval { wizard sig => [ ] };
+ like($@, qr/Invalid\s+numeric\s+signature/, 'non numeric signature croaks');
+ is($wiz3, undef, 'non numeric signature doesn\'t return anything');
 
  my $a = 1;
  my $res = eval { cast $a, $wiz };
ok(!$@, "cast from wizard croaks ($@)");
- ok($res, 'cast from wizard invalid');
is($@, '', 'cast from wizard doesn\'t croak');
+ ok($res,   'cast from wizard invalid');
 
  $res = eval { dispell $a, $wiz2 };
ok(!$@, "dispell from retrieved wizard croaks ($@)");
- ok($res, 'dispell from retrieved wizard invalid');
is($@, '', 'dispell from retrieved wizard doesn\'t croak');
+ ok($res,   'dispell from retrieved wizard invalid');
 
  $res = eval { cast $b, $sig };
ok(!$@, "cast from integer croaks ($@)");
- ok($res, 'cast from integer invalid');
is($@, '', 'cast from integer doesn\'t croak');
+ 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');
+is($@, '', 'cast from float doesn\'t croak');
+ok($res,   'cast from float invalid');
 
 $res = eval { cast $d, sprintf "%u", $sig };
-ok(!$@, "cast from string croaks ($@)");
-ok($res, 'cast from string invalid');
+is($@, '', 'cast from string doesn\'t croak');
+ok($res,   'cast from string invalid');
 
 $res = eval { dispell $b, $sig };
-ok(!$@, "dispell from integer croaks ($@)");
-ok($res, 'dispell from integer invalid');
+is($@, '', 'dispell from integer doesn\'t croak');
+ok($res,   'dispell from integer invalid');
 
 $res = eval { dispell $c, $sig + 0.1 };
-ok(!$@, "dispell from float croaks ($@)");
-ok($res, 'dispell from float invalid');
+is($@, '', 'dispell from float doesn\'t croak');
+ok($res,   'dispell from float invalid');
 
 $res = eval { dispell $d, sprintf "%u", $sig };
-ok(!$@, "dispell from string croaks ($@)");
-ok($res, 'dispell from string invalid');
+is($@, '', 'dispell from string doesn\'t croak');
+ok($res,   'dispell from string invalid');