view release on metacpan or  search on metacpan

lib/Perl/ToPerl6/TestUtils.pm  view on Meta::CPAN

        if ( /^#-->/ ) {
            $original_done = 1;
            next;
        }
        elsif ( $original_done ) {
            push @sample, $_;
        }
        else {
            push @original, $_;
        }
    }
    return (\@original, \@sample);
}

sub _finalize_subtest {
    my $subtest = shift;

    if ( $subtest->{code} ) {
        my $code = delete $subtest->{code};
        @{$subtest}{qw(original sample)} = _split_subtest($code);
        delete $subtest->{code};
    }
    else {
        throw_internal "$subtest->{name} has no code lines";
    }
    if ( !defined $subtest->{failures} ) {
        throw_internal "$subtest->{name} does not specify failures";
    }
    if ($subtest->{parms}) {
        $subtest->{parms} = eval $subtest->{parms};
        if ($EVAL_ERROR) {
            throw_internal
                "$subtest->{name} has an error in the 'parms' property:\n"
                  . $EVAL_ERROR;
        }
        if ('HASH' ne ref $subtest->{parms}) {
            throw_internal
                "$subtest->{name} 'parms' did not evaluate to a hashref";
        }
    } else {
        $subtest->{parms} = {};
    }

    if (defined $subtest->{error}) {
        if ( $subtest->{error} =~ m{ \A / (.*) / \z }xms) {
            $subtest->{error} = eval {qr/$1/};
            if ($EVAL_ERROR) {
                throw_internal
                    "$subtest->{name} 'error' has a malformed regular expression";
            }
        }
    }

    return $subtest;
}

sub bundled_transformer_names {
    require ExtUtils::Manifest;
    my $manifest = ExtUtils::Manifest::maniread();
    my @transformer_paths = map {m{\A lib/(Perl/ToPerl6/Transformer/.*).pm \z}xms} keys %{$manifest};
    my @transformers = map { join q{::}, split m{/}xms } @transformer_paths;
    my @sorted_transformers = sort @transformers;
    return @sorted_transformers;
}

sub names_of_transformers_willing_to_work {
    my %configuration = @_;

    my @transformers_willing_to_work =
        Perl::ToPerl6::Config
            ->new( %configuration )
            ->transformers();

    return map { ref } @transformers_willing_to_work;
}

1;

__END__

#-----------------------------------------------------------------------------

=pod

=for stopwords RCS subtest subtests

=head1 NAME

Perl::ToPerl6::TestUtils - Utility functions for testing new Transformers.


=head1 INTERFACE SUPPORT

This is considered to be a public module.  Any changes to its
interface will go through a deprecation cycle.


=head1 SYNOPSIS

    use Perl::ToPerl6::TestUtils qw(transform ptransform ftransform);

    my $code = '<<END_CODE';
    package Foo::Bar;
    $foo = frobulator();
    $baz = $foo ** 2;
    1;
    END_CODE

    # Critique code against all loaded transformers...
    my $perl_mogrify_config = { -necessity => 2 };
    my $transformation_count = transform( \$code, $perl_mogrify_config);

    # Critique code against one transformer...
    my $custom_transformer = 'Miscellanea::ProhibitFrobulation'
    my $transformation_count = ptransform( $custom_transformer, \$code );

    # Critique code against one filename-related transformer...
    my $custom_transformer = 'Modules::RequireFilenameMatchesPackage'
    my $transformation_count = ftransform( $custom_transformer, \$code, 'Foo/Bar.pm' );