<commit_before>=head1 NAME

Parrot::Test::P6GE - test functions for Perl 6 Grammar Engine

=head1 SYNOPSIS

In a .t file:

  use Parrot::Test tests => 2;
  use Parrot::Test::P6GE;

  p6rule_is('abc', '^abc', 'BOS abc');
  p6rule_isnt('abc', '^bc', 'BOS bc');
  p6rule_like('abcdef', 'bcd', qr/0: <bcd @ 1>/, '$0 capture');

=head1 DESCRIPTION

Parrot::Test::P6GE provides functions for testing the grammar engine
and Perl 6 rules.

=cut

use strict;

require Parrot::Test;

=head2 Functions

=over 4

=item C<p6rule_is($target, $pattern, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if they match.  Note that the pattern should be specified as a string
and without leading/trailing pattern delimiters.  (Hint: if you try
using qr// for the $pattern then you're misreading what this does.)

=cut

sub p6rule_is {
    my ($target, $pattern, $description) = @_;
    Parrot::Test::pir_output_is(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern),
            'matched',
            $description);
}

=item C<p6rule_isnt($target, $pattern, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if they do not match.

=cut

sub p6rule_isnt {
    my ($target, $pattern, $description) = @_;
    Parrot::Test::pir_output_is(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern),
            'failed',
            $description);
}

=item C<p6rule_like($target, $pattern, $expected, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if the output produced by the test code matches the C<$expected>
parameter.  Note that C<$expected> is a I<Perl 5> pattern.

=cut

sub p6rule_like {
    my ($target, $pattern, $expected, $description) = @_;
    Parrot::Test::pir_output_like(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern, 1),
            $expected,
            $description);
}

package Parrot::Test::P6GE;

sub _parrot_stringify {
    $_ = $_[0];
    s/\n/\\n/g;
    s/\r/\\r/g;
    s/\"/\\"/g;
    s/\\/\\\\/g;
    return $_;
}

sub _generate_pir_for {
    my($target, $pattern, $captures) = @_;
    $target = _parrot_stringify($target);
    $pattern = _parrot_stringify($pattern);
    if ($captures) { 
        $captures = qq(
            print "\\n"
            match."_print"()\n); 
    }
    return qq(
        .sub _P6GE_Test
            .local pmc p6rule_compile
            load_bytecode "compilers/p6ge/p6ge.pir"
            p6rule_compile = global "_p6ge_compile"

            .local string target
            .local string pattern
            .local pmc rulesub
            .local pmc match
            target = "$target"
            pattern = "$pattern"
            rulesub = p6rule_compile(pattern)
            match = rulesub(target)
            unless match goto match_fail
          match_success:
            print "matched"
            $captures
            goto match_end<commit_msg>Fixed bug in _parrot_stringify (escaped backslashes in wrong order)<commit_after>=head1 NAME

Parrot::Test::P6GE - test functions for Perl 6 Grammar Engine

=head1 SYNOPSIS

In a .t file:

  use Parrot::Test tests => 2;
  use Parrot::Test::P6GE;

  p6rule_is('abc', '^abc', 'BOS abc');
  p6rule_isnt('abc', '^bc', 'BOS bc');
  p6rule_like('abcdef', 'bcd', qr/0: <bcd @ 1>/, '$0 capture');

=head1 DESCRIPTION

Parrot::Test::P6GE provides functions for testing the grammar engine
and Perl 6 rules.

=cut

use strict;

require Parrot::Test;

=head2 Functions

=over 4

=item C<p6rule_is($target, $pattern, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if they match.  Note that the pattern should be specified as a string
and without leading/trailing pattern delimiters.  (Hint: if you try
using qr// for the $pattern then you're misreading what this does.)

=cut

sub p6rule_is {
    my ($target, $pattern, $description) = @_;
    Parrot::Test::pir_output_is(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern),
            'matched',
            $description);
}

=item C<p6rule_isnt($target, $pattern, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if they do not match.

=cut

sub p6rule_isnt {
    my ($target, $pattern, $description) = @_;
    Parrot::Test::pir_output_is(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern),
            'failed',
            $description);
}

=item C<p6rule_like($target, $pattern, $expected, $description)>

Runs the target string against the Perl 6 pattern, passing the test
if the output produced by the test code matches the C<$expected>
parameter.  Note that C<$expected> is a I<Perl 5> pattern.

=cut

sub p6rule_like {
    my ($target, $pattern, $expected, $description) = @_;
    Parrot::Test::pir_output_like(
            Parrot::Test::P6GE::_generate_pir_for($target, $pattern, 1),
            $expected,
            $description);
}

package Parrot::Test::P6GE;

sub _parrot_stringify {
    $_ = $_[0];
    s/\\/\\\\/g;
    s/\n/\\n/g;
    s/\r/\\r/g;
    s/\"/\\"/g;
    return $_;
}

sub _generate_pir_for {
    my($target, $pattern, $captures) = @_;
    $target = _parrot_stringify($target);
    $pattern = _parrot_stringify($pattern);
    if ($captures) { 
        $captures = qq(
            print "\\n"
            match."_print"()\n); 
    }
    return qq(
        .sub _P6GE_Test
            .local pmc p6rule_compile
            load_bytecode "compilers/p6ge/p6ge.pir"
            p6rule_compile = global "_p6ge_compile"

            .local string target
            .local string pattern
            .local pmc rulesub
            .local pmc match
            target = "$target"
            pattern = "$pattern"
            rulesub = p6rule_compile(pattern)
            match = rulesub(target)
            unless match goto match_fail
          match_success:
            print "matched"
            $captures
            goto match_end
{'fraction_non_alphanumeric': 0.12420275260154415, 'fraction_numerical': 0.01342732460557234, 'mean_word_length': 2.6491120636864665, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 19, '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': '1842164', 'n_tokens_mistral': 2025, 'n_tokens_neox': 1944, 'n_words': 553}