<commit_before>use v6;

use Test;

plan 24;

=begin desc

Tests C<CATCH> blocks.

=end desc



# L<S04/"Exception handlers"/If you define a CATCH block within the try, it replaces the default CATCH>

#?rakudo 2 todo 'empty CATCH block'
dies_ok { die 'blah'; CATCH {} }, 'Empty CATCH rethrows exception';
dies_ok { try {die 'blah'; CATCH {}} }, 'CATCH in try overrides default exception handling';



# L<S04/"Exception handlers"/any block can function as a try block if you put a CATCH block within it>

lives_ok { die 'blah'; CATCH {default {}} }, 'Closure with CATCH {default {}} ignores exceptions';
lives_ok { do {die 'blah'; CATCH {default {}}}; }, 'do block with CATCH {default {}} ignores exceptions';

{
    my $f = sub { die 'blah'; CATCH {default {}} };
    lives_ok $f, 'Subroutine with CATCH {default {}} ignores exceptions';

    $f = sub ($x) {
        if $x {
            die 'blah';
            CATCH { default {} }
        }
        else {
            die 'blah';
        }
    };
    lives_ok { $f(1) }, 'if block with CATCH {default {}} ignores exceptions...';
    dies_ok { $f(0) }, "...but the CATCH doesn't affect exceptions thrown in an attached else";
}



#L<S04/"Exception handlers"/An exception handler is just a switch statement>

#unless eval 'Exception.new' {
#    skip_rest "No Exception objects"; exit;
#}

{
    # exception classes
    class Naughty is Exception {};

    my ($not_died, $caught);
    {
        die Naughty.new();

        $not_died = 1;

        CATCH {
            when Naughty {
                $caught = 1;
            }
        }
    };

    ok(!$not_died, "did not live after death");
    #?pugs 1 todo
    #?rakudo todo 'smart matching against exception'
    ok($caught, "caught exception of class Naughty");
};

{
    # exception superclass
    class Naughty::Specific is Naughty {};
    class Naughty::Other is Naughty {};

    my ($other, $naughty);
    {
        die Naughty::Specific("error");

        CATCH {
            when Naughty::Other {
                $other = 1;
            }
            when Naughty {
                $naughty = 1;
            }
        }
    };

    ok(!$other, "did not catch sibling error class");
    #?pugs 1 todo
    #?rakudo todo 'smart matching against exception'
    ok($naughty, "caught superclass");
};

{
    # uncaught class
    class Dandy is Exception {};

    my ($naughty, $lived);
        {
            die Dandy.new();

            CATCH {
                when Naughty {
                    $naughty = 1;
                }
            }
        };
        $lived = 1;

    #?rakudo todo 'smart matching in CATCH'
    ok(!$lived, "did not live past uncaught throw");
    ok(!$naughty, "did not get caught by wrong handler");
    ok(WHAT($!).gist, '$! is an object');
    #?pugs skip 'bug'
    #?rakudo todo 'Exception types'
    is(WHAT($!).gist, Dandy.gist, ".. of the right class");
};

#?rakudo skip 'loops'
{
    my $s = '';
    die 3;
    CATCH {
        when 1 {$s ~= 'a';}
        when 2 {$s ~= 'b';}
        when 3 {$s ~= 'c';}
        when 4 {$s ~= 'd';}
        default {$s ~= 'z';}
    }

    is $s, 'c', 'Caught number';
};

{
    my $catches = 0;
    sub rt63430 {
        {
            return 63430;
            CATCH { return 73313 if ! $catches++; }
        }
    }

    is rt63430().perl, 63430.perl, 'can call rt63430() and examine the result';
    is rt63430(), 63430, 'CATCH does not intercept return from bare block';
    is $catches, 0, 'CATCH block never invoked';
};



# L<S04/"Exception handlers"/a CATCH block never attempts to handle any exception thrown within its own dynamic scope>

{
    my $catches = 0;
    try {
        {
            die 'catch!';
            CATCH { default {die 'caught' if ! $catches++;} }
        };
    }

    #?rakudo 2 todo 'CATCH block catching its own exceptions (RT #64262)'
    is $catches, 1, "CATCH doesn't catch exceptions thrown in its own lexical scope";

    $catches = 0;
    my $f = { die 'caught' if ! $catches++; };
    try {
        {
            die 'catch!';
            CATCH { default {$f()} }<commit_msg>Corrections and re-fudging of S04-exception-handlers/catch.t.<commit_after>use v6;

use Test;

plan 24;

=begin desc

Tests C<CATCH> blocks.

=end desc



# L<S04/"Exception handlers"/If you define a CATCH block within the try, it replaces the default CATCH>

dies_ok { die 'blah'; CATCH {} }, 'Empty CATCH rethrows exception';
dies_ok { try {die 'blah'; CATCH {}} }, 'CATCH in try overrides default exception handling';

# L<S04/"Exception handlers"/any block can function as a try block if you put a CATCH block within it>

lives_ok { die 'blah'; CATCH {default {}} }, 'Closure with CATCH {default {}} ignores exceptions';
lives_ok { do {die 'blah'; CATCH {default {}}}; }, 'do block with CATCH {default {}} ignores exceptions';

{
    my $f = sub { die 'blah'; CATCH {default {}} };
    lives_ok $f, 'Subroutine with CATCH {default {}} ignores exceptions';

    $f = sub ($x) {
        if $x {
            die 'blah';
            CATCH { default {} }
        }
        else {
            die 'blah';
        }
    };
    lives_ok { $f(1) }, 'if block with CATCH {default {}} ignores exceptions...';
    dies_ok { $f(0) }, "...but the CATCH doesn't affect exceptions thrown in an attached else";
}



#L<S04/"Exception handlers"/An exception handler is just a switch statement>

#unless eval 'Exception.new' {
#    skip_rest "No Exception objects"; exit;
#}

{
    # exception classes
    class Naughty is Exception {};

    my ($not_died, $caught);
    {
        die Naughty.new();

        $not_died = 1;

        CATCH {
            when Naughty {
                $caught = 1;
            }
        }
    };

    ok(!$not_died, "did not live after death");
    #?pugs 1 todo
    ok($caught, "caught exception of class Naughty");
};

{
    # exception superclass
    class Naughty::Specific is Naughty {};
    class Naughty::Other is Naughty {};

    my ($other, $naughty);
    {
        die Naughty::Specific.new();

        CATCH {
            when Naughty::Other {
                $other = 1;
            }
            when Naughty {
                $naughty = 1;
            }
        }
    };

    ok(!$other, "did not catch sibling error class");
    #?pugs 1 todo
    #?rakudo todo 'smart matching against exception'
    ok($naughty, "caught superclass");
};

{
    # uncaught class
    class Dandy is Exception {};

    my ($naughty, $lived);
    try {
        {
            die Dandy.new();

            CATCH {
                when Naughty {
                    $naughty = 1;
                }
            }
        };
        $lived = 1;
    }
    
    ok(!$lived, "did not live past uncaught throw");
    ok(!$naughty, "did not get caught by wrong handler");
    ok(WHAT($!).gist, '$! is an object');
    #?pugs skip 'bug'
    is(WHAT($!).gist, Dandy.gist, ".. of the right class");
};

{
    my $s = '';
    {
        die 3;
        CATCH {
            when 1 {$s ~= 'a';}
            when 2 {$s ~= 'b';}
            when 3 {$s ~= 'c';}
            when 4 {$s ~= 'd';}
            default {$s ~= 'z';}
        }
    }

    is $s, 'c', 'Caught number';
};

{
    my $catches = 0;
    sub rt63430 {
        {
            return 63430;
            CATCH { return 73313 if ! $catches++; }
        }
    }

    is rt63430().perl, 63430.perl, 'can call rt63430() and examine the result';
    is rt63430(), 63430, 'CATCH does not intercept return from bare block';
    is $catches, 0, 'CATCH block never invoked';
};



# L<S04/"Exception handlers"/a CATCH block never attempts to handle any exception thrown within its own dynamic scope>

{
    my $catches = 0;
    try {
        {
            die 'catch!';
            CATCH { default {die 'caught' if ! $catches++;} }
        };
    }

    is $catches, 1, "CATCH doesn't catch exceptions thrown in its own lexical scope";

    $catches = 0;
    my $f = { die 'caught' if ! $catches++; };
    try {
        {
            die 'catch!';
            CATCH { default {$f()} }
{'fraction_non_alphanumeric': 0.13858424725822532, 'fraction_numerical': 0.018818544366899302, 'mean_word_length': 1.9514527399779331, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3284534', 'n_tokens_mistral': 2808, 'n_tokens_neox': 2583, 'n_words': 843}