view release on metacpan or  search on metacpan

lib/Test/Perl/ToPerl6/Transformer.pm  view on Meta::CPAN

    if ( not $ok = $have == $want ) {
        my $msg = qq(Expected $want transformations, got $have. );
        if (@transformations) { $msg .= q(Found transformations follow...); }
        push @diagnostics, $msg . "\n";
        push @diagnostics, map { qq(Found transformation: $_) } @transformations;
    }

    return ($ok, @diagnostics)
}

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

sub _evaluate_error_case {
    my ($subtest, $error) = @_;
    my ($ok, @diagnostics);

    if ( 'Regexp' eq ref $subtest->{error} ) {
        $ok = $error =~ $subtest->{error}
          or push @diagnostics, qq(Error message '$error' doesn't match $subtest->{error}.);
    }
    else {
        $ok = $subtest->{error}
          or push @diagnostics, q(Didn't get an error message when we expected one.);
    }

    return ($ok, @diagnostics);
}

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

sub _compute_test_count {
    my ($subtests_with_extras) = @_;

    # one can_ok() for each transformer
    my $ntransformers = scalar keys %{ $subtests_with_extras };

    my $nsubtests = 0;
    for my $subtest_with_extras ( values %{$subtests_with_extras} ) {
        # one [pf]transform() test per subtest
        $nsubtests += @{ $subtest_with_extras->{subtests} };
    }

    return $nsubtests + $ntransformers;
}

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

sub _compute_wanted_transformation_count {
    my ($subtest) = @_;

    # If any optional modules are NOT available, then there should be no transformations.
    return 0 if not _all_optional_modules_are_available($subtest);
    return $subtest->{failures};
}

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

sub _all_optional_modules_are_available {
    my ($subtest) = @_;
    my $optional_modules = $subtest->{optional_modules} or return 1;
    return all {eval "require $_;" or 0;} split m/,\s*/xms, $optional_modules;
}

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

sub _create_test_name {
    my ($transformer, $subtest) = @_;
    return join ' - ', $transformer, "line $subtest->{lineno}", $subtest->{name};
}

#-----------------------------------------------------------------------------
1;

__END__

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

=pod

=for stopwords subtest subtests RCS

=head1 NAME

Test::Perl::ToPerl6::Transformer - A framework for testing your custom Transformers

=head1 SYNOPSIS

    use Test::Perl::ToPerl6::Transformer qw< all_transformers_ok >;

    # Assuming .run files are inside 't' directory...
    all_transformers_ok()

    # Or if your .run files are in a different directory...
    all_transformers_ok( '-test-directory' => 'run' );

    # And if you just want to run tests for some polices...
    all_transformers_ok( -transformers => ['Some::Transformer', 'Another::Transformer'] );

    # If you want your test program to accept short Transformer names as
    # command-line parameters...
    #
    # You can then test a single transformer by running
    # "perl -Ilib t/transformer-test.t My::Transformer".
    my %args = @ARGV ? ( -transformers => [ @ARGV ] ) : ();
    all_transformers_ok(%args);


=head1 DESCRIPTION

This module provides a framework for function-testing your custom
L<Perl::ToPerl6::Transformer|Perl::ToPerl6::Transformer> modules.  Transformer testing usually
involves feeding it a string of Perl code and checking its behavior.  In the
old days, those strings of Perl code were mixed directly in the test script.
That sucked.

B<NOTE:> This module is alpha code -- interfaces and implementation are
subject to major changes.  This module is an integral part of building and
testing L<Perl::ToPerl6|Perl::ToPerl6> itself, but you should not write any code
against this module until it has stabilized.