t/13-sig.t

   1 #!perl -T
   2
   3 use Test::More tests => 24;
   4
   5 use Variable::Magic qw/wizard getsig cast dispell SIG_MIN/;
   6
   7 my $sig = 300;
   8
   9 my ($a, $b, $c, $d) = 1 .. 4;
  10
  11 {
  12  my $wiz = eval { wizard sig => $sig };
  13  ok(!$@, "wizard creation error ($@)");
  14  ok(defined $wiz, 'wizard is defined');
  15  ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
  16  ok($sig == getsig $wiz, 'wizard signature is correct');
  17
  18  my $wiz2 = eval { wizard sig => $sig };
  19  ok(!$@, "wizard retrieve error ($@)");
  20  ok(defined $wiz2, 'retrieved wizard is defined');
  21  ok(ref $wiz2 eq 'SCALAR', 'retrieved wizard is a scalar ref');
  22  ok($sig == getsig $wiz2, 'retrieved wizard signature is correct');
  23
  24  my $a = 1;
  25  my $res = eval { cast $a, $wiz };
  26  ok(!$@, "cast from wizard croaks ($@)");
  27  ok($res, 'cast from wizard invalid');
  28
  29  $res = eval { dispell $a, $wiz2 };
  30  ok(!$@, "dispell from retrieved wizard croaks ($@)");
  31  ok($res, 'dispell from retrieved wizard invalid');
  32
  33  $res = eval { cast $b, $sig };
  34  ok(!$@, "cast from integer croaks ($@)");
  35  ok($res, 'cast from integer invalid');
  36 }
  37
  38 my $res = eval { cast $c, $sig + 0.1 };
  39 ok(!$@, "cast from float croaks ($@)");
  40 ok($res, 'cast from float invalid');
  41
  42 $res = eval { cast $d, sprintf "%u", $sig };
  43 ok(!$@, "cast from string croaks ($@)");
  44 ok($res, 'cast from string invalid');
  45
  46 $res = eval { dispell $b, $sig };
  47 ok(!$@, "dispell from integer croaks ($@)");
  48 ok($res, 'dispell from integer invalid');
  49
  50 $res = eval { dispell $c, $sig + 0.1 };
  51 ok(!$@, "dispell from float croaks ($@)");
  52 ok($res, 'dispell from float invalid');
  53
  54 $res = eval { dispell $d, sprintf "%u", $sig };
  55 ok(!$@, "dispell from string croaks ($@)");
  56 ok($res, 'dispell from string invalid');
  57