PageRenderTime 98ms CodeModel.GetById 81ms app.highlight 14ms RepoModel.GetById 1ms app.codeStats 0ms

/Devel-LexAlias-0.04/t/Devel-LexAlias.t

#
Perl | 72 lines | 52 code | 18 blank | 2 comment | 0 complexity | c97e9856e70a82cc9229a814e192f428 MD5 | raw file
 1#!/usr/bin/perl -w
 2use strict;
 3use Test::More tests => 11;
 4
 5use Devel::LexAlias qw(lexalias);
 6
 7# testing for predictive destruction.  especially around ithreads
 8my $expect;
 9sub Foo::DESTROY {
10    my ($destroyed) = @{ shift() };
11    is( $destroyed, $expect, "expected destruction of $expect" );
12}
13
14sub inner {
15    my $inner = bless ['$inner'], 'Foo';
16    $expect = '$outer';
17    lexalias(1, '$outer', \$inner);
18    $expect = '';
19}
20
21sub outer {
22    my $outer = bless [ '$outer' ], 'Foo';
23    inner;
24    is ( $outer->[0], '$inner', "alias worked" );
25    $expect = '$inner';
26}
27outer;
28
29sub steal_foo {
30    my $foo = 1;
31    lexalias(\&foo, '$x', \$foo);
32    lexalias(\&foo, '@y', [qw( foo bar baz )]);
33
34    eval { lexalias(\&foo, '$x', $foo) };
35    ok( $@, "blew an error" );
36    like( $@, qr/^ref is not a reference/, "useful error" );
37}
38
39sub bar {
40    my $foo = 2;
41    lexalias(2, '$x', \$foo);
42}
43
44sub steal_above {
45    bar();
46    lexalias(1, '@y', [qw( foo bar bray )]);
47}
48
49
50sub foo {
51    my $x = 22;
52    my @y = qw( a b c );
53
54    is( $x, 22, "x before" );
55    is_deeply( \@y, [qw( a b c )], "y before" );
56
57    steal_foo;
58
59    is( $x, 1, "x after" );
60    is_deeply( \@y, [qw( foo bar baz )], "y after" );
61
62    steal_above;
63
64    is( $x, 2, "x above after" );
65    is_deeply( \@y, [qw( foo bar bray )], "y after" );
66
67}
68
69foo;
70print "# out of foo\n";
71
72exit 0;