<commit_before>#! perl
# Copyright (C) 2001-2008, Parrot Foundation.
# $Id$

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 31;

=head1 NAME

t/pmc/exception.t - Exception Handling

=head1 SYNOPSIS

    % prove t/pmc/exception.t

=head1 DESCRIPTION

Tests C<Exception> and C<ExceptionHandler> PMCs.

=cut

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh" );
    push_eh _handler
    print "ok 1\n"
    pop_eh
    print "ok 2\n"
    end
_handler:
    end
CODE
ok 1
ok 2
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh, PMC exception handler" );
.sub main :main
    $P0 = new ['ExceptionHandler']
    set_addr $P0, _handler
    push_eh $P0
    print "ok 1\n"
    pop_eh
    print "ok 2\n"
    end
_handler:
    print "caught it\n"
    end
.end
CODE
ok 1
ok 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
    print "main\n"
    push_eh _handler
    new P30, ['Exception']
    throw P30
    print "not reached\n"
    end
_handler:
    print "caught it\n"
    end
CODE
main
caught it
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw, PMC exception handler" );
    print "main\n"
    new P20, ['ExceptionHandler']
    set_addr P20, _handler
    push_eh P20
    new P30, ['Exception']
    throw P30
    print "not reached\n"
    end
_handler:
    print "caught it\n"
    end
CODE
main
caught it
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
    print "main\n"
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P0
    set S0, P0
    print "caught it\n"
    typeof S1, P0
    print S1
    print "\n"
    print S0
    print "\n"
    null P5
    end

CODE
main
caught it
Exception
just pining
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "exception attributes" );
    print "main\n"
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    new P3, ['Integer']
    set P3, 5
    setattribute P1, 'severity', P3
    new P4, ['String']
    set P4, "additional payload"
    setattribute P1, 'payload', P4
    new P5, ['Array']
    set P5, 2
    set P5[0], 'backtrace line 1'
    set P5[1], 'backtrace line 2'
    setattribute P1, 'backtrace', P5

    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P0
    set S0, P0
    print "caught it\n"
    getattribute P16, P0, 'message'
    print P16
    print "\n"
    getattribute P17, P0, 'severity'
    print P17
    print "\n"
    getattribute P18, P0, 'payload'
    print P18
    print "\n"
    getattribute P19, P0, 'backtrace'
    set P20, P19[0]
    print P20
    print "\n"
    set P20, P19[1]
    print P20
    print "\n"
    null P5
    end

CODE
main
caught it
just pining
5
additional payload
backtrace line 1
backtrace line 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
# see also #38459
    print "main\n"
    new P0, ['Integer']
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P1
    inc P0
    print "ok\n"
    end

CODE
main
ok
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
.sub main :main
    print "main\n"
    push_eh _handler
    $P1 = new ['Exception']
    $P2 = new ['String']
    set $P2, "just pining"
    setattribute $P1, 'message', $P2<commit_msg>[t] add 2 Exception tests to cover init_pmc<commit_after>#! perl
# Copyright (C) 2001-2008, Parrot Foundation.
# $Id$

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 33;

=head1 NAME

t/pmc/exception.t - Exception Handling

=head1 SYNOPSIS

    % prove t/pmc/exception.t

=head1 DESCRIPTION

Tests C<Exception> and C<ExceptionHandler> PMCs.

=cut

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh" );
    push_eh _handler
    print "ok 1\n"
    pop_eh
    print "ok 2\n"
    end
_handler:
    end
CODE
ok 1
ok 2
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', "push_eh - pop_eh, PMC exception handler" );
.sub main :main
    $P0 = new ['ExceptionHandler']
    set_addr $P0, _handler
    push_eh $P0
    print "ok 1\n"
    pop_eh
    print "ok 2\n"
    end
_handler:
    print "caught it\n"
    end
.end
CODE
ok 1
ok 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw" );
    print "main\n"
    push_eh _handler
    new P30, ['Exception']
    throw P30
    print "not reached\n"
    end
_handler:
    print "caught it\n"
    end
CODE
main
caught it
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "push_eh - throw, PMC exception handler" );
    print "main\n"
    new P20, ['ExceptionHandler']
    set_addr P20, _handler
    push_eh P20
    new P30, ['Exception']
    throw P30
    print "not reached\n"
    end
_handler:
    print "caught it\n"
    end
CODE
main
caught it
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "get_results" );
    print "main\n"
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P0
    set S0, P0
    print "caught it\n"
    typeof S1, P0
    print S1
    print "\n"
    print S0
    print "\n"
    null P5
    end

CODE
main
caught it
Exception
just pining
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "exception attributes" );
    print "main\n"
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    new P3, ['Integer']
    set P3, 5
    setattribute P1, 'severity', P3
    new P4, ['String']
    set P4, "additional payload"
    setattribute P1, 'payload', P4
    new P5, ['Array']
    set P5, 2
    set P5[0], 'backtrace line 1'
    set P5[1], 'backtrace line 2'
    setattribute P1, 'backtrace', P5

    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P0
    set S0, P0
    print "caught it\n"
    getattribute P16, P0, 'message'
    print P16
    print "\n"
    getattribute P17, P0, 'severity'
    print P17
    print "\n"
    getattribute P18, P0, 'payload'
    print P18
    print "\n"
    getattribute P19, P0, 'backtrace'
    set P20, P19[0]
    print P20
    print "\n"
    set P20, P19[1]
    print P20
    print "\n"
    null P5
    end

CODE
main
caught it
just pining
5
additional payload
backtrace line 1
backtrace line 2
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with String' );
.sub main :main
  .local pmc ex, exr
  .local pmc msg, msgr
  msg = new ['String']
  msg = 'Message'
  ex = new ['Exception'], msg
  push_eh handler
  throw ex
  say 'Never here'
handler:
  .get_results(exr)
  msgr = exr['message']
  say msgr
.end
CODE
Message
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', 'Exception initialized with Hash' );
.sub main :main
  .local pmc ex, exr
  .local pmc h, msgr
  h = new ['Hash']
  h['message'] = 'Message'
  ex = new ['Exception'], h
  push_eh handler
  throw ex
  say 'Never here'
handler:
  .get_results(exr)
  msgr = exr['message']
  say msgr
.end
CODE
Message
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "get_results - be sure registers are ok" );
# see also #38459
    print "main\n"
    new P0, ['Integer']
    push_eh handler
    new P1, ['Exception']
    new P2, ['String']
    set P2, "just pining"
    setattribute P1, 'message', P2
    throw P1
    print "not reached\n"
    end
handler:
    get_results "0", P1
    inc P0
    print "ok\n"
    end

CODE
main
ok
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', ".get_results() - PIR" );
.sub main :main
    print "main\n"
    push_eh _handler
    $P1 = new ['Exception']
    $P2 = new ['String']
    set $P2, "just pining"
    setattribute $P1, 'message', $P2
{'fraction_non_alphanumeric': 0.12843346293741378, 'fraction_numerical': 0.03499310171829926, 'mean_word_length': 2.6712707182320443, 'pattern_counts': {'":': 0, '<': 79, '<?xml version=': 0, '>': 9, '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': '2801820', 'n_tokens_mistral': 3169, 'n_tokens_neox': 3044, 'n_words': 988}