PageRenderTime 43ms CodeModel.GetById 19ms 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
  2. use strict;
  3. use Test::More tests => 11;
  4. use Devel::LexAlias qw(lexalias);
  5. # testing for predictive destruction. especially around ithreads
  6. my $expect;
  7. sub Foo::DESTROY {
  8. my ($destroyed) = @{ shift() };
  9. is( $destroyed, $expect, "expected destruction of $expect" );
  10. }
  11. sub inner {
  12. my $inner = bless ['$inner'], 'Foo';
  13. $expect = '$outer';
  14. lexalias(1, '$outer', \$inner);
  15. $expect = '';
  16. }
  17. sub outer {
  18. my $outer = bless [ '$outer' ], 'Foo';
  19. inner;
  20. is ( $outer->[0], '$inner', "alias worked" );
  21. $expect = '$inner';
  22. }
  23. outer;
  24. sub steal_foo {
  25. my $foo = 1;
  26. lexalias(\&foo, '$x', \$foo);
  27. lexalias(\&foo, '@y', [qw( foo bar baz )]);
  28. eval { lexalias(\&foo, '$x', $foo) };
  29. ok( $@, "blew an error" );
  30. like( $@, qr/^ref is not a reference/, "useful error" );
  31. }
  32. sub bar {
  33. my $foo = 2;
  34. lexalias(2, '$x', \$foo);
  35. }
  36. sub steal_above {
  37. bar();
  38. lexalias(1, '@y', [qw( foo bar bray )]);
  39. }
  40. sub foo {
  41. my $x = 22;
  42. my @y = qw( a b c );
  43. is( $x, 22, "x before" );
  44. is_deeply( \@y, [qw( a b c )], "y before" );
  45. steal_foo;
  46. is( $x, 1, "x after" );
  47. is_deeply( \@y, [qw( foo bar baz )], "y after" );
  48. steal_above;
  49. is( $x, 2, "x above after" );
  50. is_deeply( \@y, [qw( foo bar bray )], "y after" );
  51. }
  52. foo;
  53. print "# out of foo\n";
  54. exit 0;