t/aggregate/unit_core_setup.t

   1 use strict;
   2 use warnings;
   3 use Class::MOP;
   4 use Catalyst::Runtime;
   5
   6 use FindBin;
   7 use lib "$FindBin::Bin/../lib";
   8
   9 use Test::More tests => 34;
  10 use Test::Exception;
  11
  12 {
  13     # Silence the log.
  14     my $meta = Catalyst::Log->meta;
  15     $meta->make_mutable;
  16     $meta->remove_method('_send_to_log');
  17     $meta->add_method('_send_to_log', sub {});
  18 }
  19
  20 sub build_test_app_with_setup {
  21     my ($name, @flags) = @_;
  22     my $flags = '(' . join(', ', map { "'".$_."'" } @flags) . ')';
  23     $flags = '' if $flags eq '()';
  24     eval qq{
  25         package $name;
  26         use Catalyst $flags;
  27         $name->setup;
  28     };
  29     die $@ if $@;
  30     return $name;
  31 }
  32
  33 local %ENV = %ENV;
  34
  35 # Remove all relevant env variables to avoid accidental fail
  36 foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
  37     delete $ENV{$name};
  38 }
  39
  40 {
  41     my $app = build_test_app_with_setup('TestAppMyTestDebug', '-Debug');
  42
  43     ok my $c = $app->new, 'Get debug app object';
  44     ok my $log = $c->log, 'Get log object';
  45     isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
  46     ok $log->is_warn, 'Warnings should be enabled';
  47     ok $log->is_error, 'Errors should be enabled';
  48     ok $log->is_fatal, 'Fatal errors should be enabled';
  49     ok $log->is_info, 'Info should be enabled';
  50     ok $log->is_debug, 'Debugging should be enabled';
  51     ok $app->debug, 'debug method should return true';
  52 }
  53
  54 {
  55     my $app = build_test_app_with_setup('TestAppMyTestLogParam', '-Log=warn,error,fatal');
  56
  57     ok my $c = $app->new, 'Get log app object';
  58     ok my $log = $c->log, 'Get log object';
  59     isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
  60     ok $log->is_warn, 'Warnings should be enabled';
  61     ok $log->is_error, 'Errors should be enabled';
  62     ok $log->is_fatal, 'Fatal errors should be enabled';
  63     ok !$log->is_info, 'Info should be disabled';
  64     ok !$log->is_debug, 'Debugging should be disabled';
  65     ok !$c->debug, 'Catalyst debugging is off';
  66 }
  67 {
  68     my $app = build_test_app_with_setup('TestAppMyTestNoParams');
  69
  70     ok my $c = $app->new, 'Get log app object';
  71     ok my $log = $c->log, 'Get log object';
  72     isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
  73     ok $log->is_warn, 'Warnings should be enabled';
  74     ok $log->is_error, 'Errors should be enabled';
  75     ok $log->is_fatal, 'Fatal errors should be enabled';
  76     ok $log->is_info, 'Info should be enabled';
  77     ok $log->is_debug, 'Debugging should be enabled';
  78     ok !$c->debug, 'Catalyst debugging turned off';
  79 }
  80 my $log_meta = Class::MOP::Class->create_anon_class(
  81     methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ },
  82 );
  83 {
  84     package TestAppWithOwnLogger;
  85     use base qw/Catalyst/;
  86     __PACKAGE__->log($log_meta->new_object);
  87     __PACKAGE__->setup('-Debug');
  88 }
  89
  90 ok my $c = TestAppWithOwnLogger->new, 'Get with own logger app object';
  91 ok $c->debug, '$c->debug is true';
  92
  93 local $TODO
  94     = 'These tests will not pass until Catalyst stops supporting old (NEXT-using) plugins';
  95
  96 {
  97     local $SIG{__WARN__} = sub {
  98         my $warn = join '', @_;
  99         die $warn if $warn =~ /Deep recursion/;
 100         warn $warn;
 101     };
 102
 103     use_ok 'TestAppSetupRecursion';
 104
 105     no warnings 'once';
 106     is $TestAppSetupRecursion::AfterCount, 1, 'setup modifier was only called once';
 107 }
 108
 109 {
 110     local $SIG{__WARN__} = sub {
 111         my $warn = join '', @_;
 112         die $warn if $warn =~ /Deep recursion/;
 113         warn $warn;
 114     };
 115
 116     use_ok 'TestAppSetupRecursionImmutable';
 117
 118     no warnings 'once';
 119     is $TestAppSetupRecursionImmutable::AfterCount, 1, 'setup modifier was only called once';
 120
 121     ok( TestAppSetupRecursionImmutable->meta->is_immutable,
 122         'package is still immutable after setup is called');
 123 }