t/12-sig.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 30;
   7
   8 use Variable::Magic qw/wizard getsig cast dispell SIG_MIN SIG_MAX/;
   9
  10 my $sig = 300;
  11
  12 my ($a, $b, $c, $d) = 1 .. 4;
  13
  14 my $inv_num_sig = qr/Invalid\s+numeric\s+signature\s+at\s+\Q$0\E/;
  15
  16 {
  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');
  22
  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');
  28
  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');
  32
  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');
  36
  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');
  40
  41  my $a = 1;
  42  my $res = eval { cast $a, $wiz };
  43  is($@, '', 'cast from wizard doesn\'t croak');
  44  ok($res,   'cast from wizard invalid');
  45
  46  $res = eval { dispell $a, $wiz2 };
  47  is($@, '', 'dispell from retrieved wizard doesn\'t croak');
  48  ok($res,   'dispell from retrieved wizard invalid');
  49
  50  $res = eval { cast $b, $sig };
  51  is($@, '', 'cast from integer doesn\'t croak');
  52  ok($res,   'cast from integer invalid');
  53 }
  54
  55 my $res = eval { cast $c, $sig + 0.1 };
  56 is($@, '', 'cast from float doesn\'t croak');
  57 ok($res,   'cast from float invalid');
  58
  59 $res = eval { cast $d, sprintf "%u", $sig };
  60 is($@, '', 'cast from string doesn\'t croak');
  61 ok($res,   'cast from string invalid');
  62
  63 $res = eval { dispell $b, $sig };
  64 is($@, '', 'dispell from integer doesn\'t croak');
  65 ok($res,   'dispell from integer invalid');
  66
  67 $res = eval { dispell $c, $sig + 0.1 };
  68 is($@, '', 'dispell from float doesn\'t croak');
  69 ok($res,   'dispell from float invalid');
  70
  71 $res = eval { dispell $d, sprintf "%u", $sig };
  72 is($@, '', 'dispell from string doesn\'t croak');
  73 ok($res,   'dispell from string invalid');
  74