]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/14-callbacks.t
Convert t/30-scalar.t to the new testing framework
[perl/modules/Variable-Magic.git] / t / 14-callbacks.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 12;
7
8 use Variable::Magic qw/wizard cast/;
9
10 my $wiz = eval { wizard get => sub { undef } };
11 is($@, '',             'wizard creation doesn\'t croak');
12 ok(defined $wiz,       'wizard is defined');
13 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
14
15 my $n = int rand 1000;
16 my $a = $n;
17
18 my $res = eval { cast $a, $wiz };
19 is($@, '', 'cast doesn\'t croak');
20 ok($res,   'cast is valid');
21
22 my $x;
23 eval {
24  local $SIG{__WARN__} = sub { die };
25  $x = $a
26 };
27 is($@, '', 'callback returning undef doesn\'t warn/croak');
28 is($x, $n, 'callback returning undef fails');
29
30 my @callers;
31 $wiz = wizard get => sub {
32  my @c;
33  my $i = 0;
34  while (@c = caller $i++) {
35   push @callers, [ @c[0, 1, 2] ];
36  }
37 };
38
39 my $b;
40 cast $b, $wiz;
41
42 my $u = $b;
43 is_deeply(\@callers, [
44  [ 'main', $0, __LINE__-2 ],
45 ], 'caller into callback returns the right thing');
46
47 @callers = ();
48 $u = $b;
49 is_deeply(\@callers, [
50  [ 'main', $0, __LINE__-2 ],
51 ], 'caller into callback returns the right thing (second time)');
52
53 {
54  @callers = ();
55  my $u = $b;
56  is_deeply(\@callers, [
57   [ 'main', $0, __LINE__-2 ]
58  ], 'caller into callback into block returns the right thing');
59 }
60
61 @callers = ();
62 eval { my $u = $b };
63 is($@, '', 'caller into callback doesn\'t croak');
64 is_deeply(\@callers, [
65  [ 'main', $0, __LINE__-3 ],
66  [ 'main', $0, __LINE__-4 ],
67 ], 'caller into callback into eval returns the right thing');