Add TODO tests for recursion bug with method modifiers on App->setup

[catagits/Catalyst-Runtime.git] / t / aggregate / unit_core_setup.t

use strict;
use warnings;
use Class::MOP;
use Catalyst::Runtime;

use FindBin;
use lib "$FindBin::Bin/../lib";

use Test::More tests => 34;
use Test::Exception;

{
    # Silence the log.
    my $meta = Catalyst::Log->meta;
    $meta->make_mutable;
    $meta->remove_method('_send_to_log');
    $meta->add_method('_send_to_log', sub {});
}

sub build_test_app_with_setup {
    my ($name, @flags) = @_;
    my $flags = '(' . join(', ', map { "'".$_."'" } @flags) . ')';
    $flags = '' if $flags eq '()';
    eval qq{
        package $name;
        use Catalyst $flags;
        $name->setup;
    };
    die $@ if $@;
    return $name;
}

local %ENV = %ENV;

# Remove all relevant env variables to avoid accidental fail
foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) {
    delete $ENV{$name};
}

{
    my $app = build_test_app_with_setup('TestAppMyTestDebug', '-Debug');

    ok my $c = $app->new, 'Get debug app object';
    ok my $log = $c->log, 'Get log object';
    isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
    ok $log->is_warn, 'Warnings should be enabled';
    ok $log->is_error, 'Errors should be enabled';
    ok $log->is_fatal, 'Fatal errors should be enabled';
    ok $log->is_info, 'Info should be enabled';
    ok $log->is_debug, 'Debugging should be enabled';
    ok $app->debug, 'debug method should return true';
}

{
    my $app = build_test_app_with_setup('TestAppMyTestLogParam', '-Log=warn,error,fatal');

    ok my $c = $app->new, 'Get log app object';
    ok my $log = $c->log, 'Get log object';
    isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
    ok $log->is_warn, 'Warnings should be enabled';
    ok $log->is_error, 'Errors should be enabled';
    ok $log->is_fatal, 'Fatal errors should be enabled';
    ok !$log->is_info, 'Info should be disabled';
    ok !$log->is_debug, 'Debugging should be disabled';
    ok !$c->debug, 'Catalyst debugging is off';
}
{
    my $app = build_test_app_with_setup('TestAppMyTestNoParams');

    ok my $c = $app->new, 'Get log app object';
    ok my $log = $c->log, 'Get log object';
    isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object';
    ok $log->is_warn, 'Warnings should be enabled';
    ok $log->is_error, 'Errors should be enabled';
    ok $log->is_fatal, 'Fatal errors should be enabled';
    ok $log->is_info, 'Info should be enabled';
    ok $log->is_debug, 'Debugging should be enabled';
    ok !$c->debug, 'Catalyst debugging turned off';
}
my $log_meta = Class::MOP::Class->create_anon_class(
    methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ },
);
{
    package TestAppWithOwnLogger;
    use base qw/Catalyst/;
    __PACKAGE__->log($log_meta->new_object);
    __PACKAGE__->setup('-Debug');
}

ok my $c = TestAppWithOwnLogger->new, 'Get with own logger app object';
ok $c->debug, '$c->debug is true';

local $TODO
    = 'These tests will not pass until Catalyst stops supporting old (NEXT-using) plugins';

{
    local $SIG{__WARN__} = sub {
        my $warn = join '', @_;
        die $warn if $warn =~ /Deep recursion/;
        warn $warn;
    };

    use_ok 'TestAppSetupRecursion';

    no warnings 'once';
    is $TestAppSetupRecursion::AfterCount, 1, 'setup modifier was only called once';
}

{
    local $SIG{__WARN__} = sub {
        my $warn = join '', @_;
        die $warn if $warn =~ /Deep recursion/;
        warn $warn;
    };

    use_ok 'TestAppSetupRecursionImmutable';

    no warnings 'once';
    is $TestAppSetupRecursionImmutable::AfterCount, 1, 'setup modifier was only called once';

    ok( TestAppSetupRecursionImmutable->meta->is_immutable,
        'package is still immutable after setup is called');
}