t/preserve-object.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4
   5 {
   6     package MyApp;
   7     use Moose;
   8     use Catalyst;
   9     no Moose;
  10
  11     sub _is_this_the_app { 'oh yeah' }
  12 }
  13
  14 {
  15     package Foo;
  16     use base qw/Catalyst::Component::ACCEPT_CONTEXT Catalyst::Component/;
  17
  18     sub new {
  19         my $class = shift;
  20         return $class->next::method(@_);
  21     }
  22 }
  23
  24 use Test::More tests => 4;
  25 use Scalar::Util qw/refaddr/;
  26
  27 my $app_class = 'MyApp';
  28
  29 my $foo = Foo->COMPONENT($app_class, { args => 'yes' });
  30 is $foo->{args}, 'yes', 'foo created';
  31 is $foo->context->_is_this_the_app, 'oh yeah', 'got app';
  32
  33 my $ctx = { };
  34 my $foo2 = $foo->ACCEPT_CONTEXT($ctx);
  35 is refaddr($foo), refaddr($foo2), 'foo and foo2 are the same ref';
  36 is refaddr($foo->context), refaddr($ctx), 'got ctx';
  37