/Devel-LexAlias-0.04/t/Devel-LexAlias.t
Perl | 72 lines | 52 code | 18 blank | 2 comment | 0 complexity | c97e9856e70a82cc9229a814e192f428 MD5 | raw file
- #!/usr/bin/perl -w
- use strict;
- use Test::More tests => 11;
- use Devel::LexAlias qw(lexalias);
- # testing for predictive destruction. especially around ithreads
- my $expect;
- sub Foo::DESTROY {
- my ($destroyed) = @{ shift() };
- is( $destroyed, $expect, "expected destruction of $expect" );
- }
- sub inner {
- my $inner = bless ['$inner'], 'Foo';
- $expect = '$outer';
- lexalias(1, '$outer', \$inner);
- $expect = '';
- }
- sub outer {
- my $outer = bless [ '$outer' ], 'Foo';
- inner;
- is ( $outer->[0], '$inner', "alias worked" );
- $expect = '$inner';
- }
- outer;
- sub steal_foo {
- my $foo = 1;
- lexalias(\&foo, '$x', \$foo);
- lexalias(\&foo, '@y', [qw( foo bar baz )]);
- eval { lexalias(\&foo, '$x', $foo) };
- ok( $@, "blew an error" );
- like( $@, qr/^ref is not a reference/, "useful error" );
- }
- sub bar {
- my $foo = 2;
- lexalias(2, '$x', \$foo);
- }
- sub steal_above {
- bar();
- lexalias(1, '@y', [qw( foo bar bray )]);
- }
- sub foo {
- my $x = 22;
- my @y = qw( a b c );
- is( $x, 22, "x before" );
- is_deeply( \@y, [qw( a b c )], "y before" );
- steal_foo;
- is( $x, 1, "x after" );
- is_deeply( \@y, [qw( foo bar baz )], "y after" );
- steal_above;
- is( $x, 2, "x above after" );
- is_deeply( \@y, [qw( foo bar bray )], "y after" );
- }
- foo;
- print "# out of foo\n";
- exit 0;