t/12-sig.t

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