Perl-ToPerl6

 view release on metacpan or  search on metacpan

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

    #
    #############################################################################

    my @disabled_transformer_names = ();
    if ( my ($patterns_string) = $annotation_element =~ $no_mogrify ) {

        # Compose the specified modules into a regex alternation.  Wrap each
        # in a no-capturing group to permit "|" in the modules specification.

        my @transformer_name_patterns = grep { $_ ne $EMPTY }
            split m{\s *[,\s] \s*}xms, $patterns_string;
        my $re = join $PIPE, map {"(?:$_)"} @transformer_name_patterns;
        my @site_transformer_names = Perl::ToPerl6::TransformerFactory::site_transformer_names();
        @disabled_transformer_names = grep {m/$re/ixms} @site_transformer_names;

        # It is possible that the Transformer patterns listed in the annotation do not
        # match any of the site transformer names.  This could happen when running
        # on a machine that does not have the same set of Transformers as the
        # author.
        # So we must return something here, otherwise all Transformers will be
        # disabled.  We probably need to add a mechanism to (optionally) warn

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

        }
    }

    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 )

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

#-----------------------------------------------------------------------------
# Some static helper subs

sub _modules_from_blib {
    my (@modules) = @_;
    return grep { _was_loaded_from_blib( _module2path($_) ) } @modules;
}

sub _module2path {
    my $module = shift || return;
    return File::Spec::Unix->catdir(split m/::/xms, $module) . '.pm';
}

sub _was_loaded_from_blib {
    my $path = shift || return;
    my $full_path = $INC{$path};
    return $full_path && $full_path =~ m/ (?: \A | \b b ) lib \b /xms;
}

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

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

    # 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};
}

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

t/12_transformer_listing.t  view on Meta::CPAN

my $transformer_count = scalar @transformers;

plan( tests => $transformer_count + 1);

#-----------------------------------------------------------------------------
# These tests verify that the listing has the right number of lines (one per
# transformer) and that each line matches the expected pattern.  This indirectly
# verifies that each core transformer declares at least one theme.

my $listing_as_string = "$listing";
my @listing_lines = split m/ \n /xms, $listing_as_string;
my $line_count = scalar @listing_lines;
is( $line_count, $transformer_count, qq{Listing has all $transformer_count transformers} );


my $listing_pattern = qr< \A \d [ ] [\w:]+ [ ] \[ [\w\s]+ \] \z >xms;
for my $line ( @listing_lines ) {
    like($line, $listing_pattern, 'Listing format matches expected pattern');
}

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