view release on metacpan or  search on metacpan

t/04-options.t  view on Meta::CPAN

    Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red');
    reset_capture();
    no warnings 'redefine';
    local *Devel::Bug::_isTerm    = sub { 1 };
    local *Devel::Bug::_sttyWidth = sub { 80 };
    my $in;
    ($in = bug('c') = 42);
    like $buf, qr/\e\[/, 'color=AUTO produces ANSI codes on terminal';
}

# color=ON + terminal: ANSI codes applied
{
    Devel::Bug->import(out => *TESTOUT, color => 1, vc => 'red');
    reset_capture();
    no warnings 'redefine';
    local *Devel::Bug::_isTerm    = sub { 1 };
    local *Devel::Bug::_sttyWidth = sub { 80 };
    my $in;
    ($in = bug('c') = 42);
    like $buf, qr/\e\[/, 'color=ON produces ANSI codes on terminal';
}

# ---------------------------------------------------------------------------
# noterm option
# ---------------------------------------------------------------------------

# baseline: color=AUTO on mocked terminal produces ANSI codes
{
    Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red');
    reset_capture();
    no warnings 'redefine';
    local *Devel::Bug::_isTerm    = sub { 1 };
    local *Devel::Bug::_sttyWidth = sub { 80 };
    my $in;
    ($in = bug('c') = 42);
    like $buf, qr/\e\[/, 'color=AUTO on terminal produces ANSI codes (baseline)';
}

# noterm=1 suppresses terminal detection: color=AUTO stays uncolored
{
    Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red', noterm => 1);
    reset_capture();
    no warnings 'redefine';
    local *Devel::Bug::_isTerm    = sub { 1 };
    local *Devel::Bug::_sttyWidth = sub { 80 };
    my $in;
    ($in = bug('c') = 42);
    unlike $buf, qr/\e\[/, 'noterm=1 suppresses terminal detection for color=AUTO';
}

# noterm=1 does not suppress color=ON
{
    Devel::Bug->import(out => *TESTOUT, color => 1, vc => 'red', noterm => 1);
    reset_capture();
    my $in;
    ($in = bug('c') = 42);
    like $buf, qr/\e\[/, 'noterm=1 does not suppress color=ON';
}

# ---------------------------------------------------------------------------
# terminal width detection cascade: stty → Term::Size::Perl
# Simulate unavailability via an @INC hook that blocks Term/Size/Perl.pm.
# ---------------------------------------------------------------------------
{
    my $attempts = 0;

    my $block = sub {
        return unless $_[1] eq 'Term/Size/Perl.pm';
        $attempts++;
        die "Term::Size::Perl not available\n";
    };

    # noterm=1: detection skipped entirely — neither stty nor Term::Size::Perl attempted
    {
        no warnings 'redefine';
        local *Devel::Bug::_isTerm    = sub { 1 };
        local *Devel::Bug::_sttyWidth = sub { 0 };
        $attempts = 0;
        delete local $INC{'Term/Size/Perl.pm'};
        local @INC = ($block, @INC);

        Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red', noterm => 1);
        reset_capture();
        my $in;
        ($in = bug('c') = 42);
        is     $attempts, 0,       'noterm=1: Term::Size::Perl not attempted';
        unlike $buf,      qr/\e\[/,'noterm=1: no colors (termW=0)';
        is     $in,       42,      'noterm=1: value passes through';
    }

    # stty works: Term::Size::Perl not attempted
    {
        no warnings 'redefine';
        local *Devel::Bug::_isTerm    = sub { 1 };
        local *Devel::Bug::_sttyWidth = sub { 80 };
        $attempts = 0;
        delete local $INC{'Term/Size/Perl.pm'};
        local @INC = ($block, @INC);

        Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red');
        reset_capture();
        my $in;
        ($in = bug('c') = 42);
        is   $attempts, 0,      'stty works: Term::Size::Perl not attempted';
        like $buf,      qr/\e\[/,'stty works: terminal detected, colors applied';
    }

    # stty fails, Term::Size::Perl works: termW from Term::Size::Perl
    {
        no warnings 'redefine';
        local *Devel::Bug::_isTerm    = sub { 1 };
        local *Devel::Bug::_sttyWidth = sub { 0 };
        local *Devel::Bug::_tspWidth  = sub { 80 };

        Devel::Bug->import(out => *TESTOUT, color => '', vc => 'red');
        reset_capture();
        my $in;
        ($in = bug('c') = 42);
        like $buf, qr/\e\[/, 'stty fails, Term::Size::Perl works: colors applied';
    }