view release on metacpan or  search on metacpan

lib/Test/MetaSyntactic.pm  view on Meta::CPAN

}

# t/21format.t
sub subtest_format {
    my ($theme) = @_;
    my $tb = __PACKAGE__->builder;

    my @metas = _theme_sublists($theme);
    $tb->plan( tests => scalar @metas );

    for my $test (@metas) {
        my ( $ams, $theme ) = @$test;
        my @items = $ams->name(0);
        my @failed;
        my $ok = 0;
        ( /^[A-Za-z_]\w*$/ && ++$ok ) || push @failed, $_ for @items;
        $tb->is_num( $ok, scalar @items, "All names correct for $theme" );
        $tb->diag("Bad names: @failed") if @failed;
    }
}

# t/23length.t
sub subtest_length {
    my ($theme) = @_;
    my $tb = __PACKAGE__->builder;

    my @metas = _theme_sublists($theme);
    $tb->plan( tests => 2 * @metas );

    for my $t (@metas) {
        my ( $ams, $theme ) = @$t;

        # no empty themes
        my @items = $ams->name(0);
        $tb->cmp_ok( 0 + @items, '>=', 1, "$theme has at least one item" );

        # no empty names
        my @failed;
        my $ok = 0;
        ( length($_) >= 1 && length($_) <= 251 && ++$ok ) || push @failed, $_
            for @items;
        $tb->is_num( $ok, scalar @items, "All names correct for $theme" );
        $tb->diag("Names too long: @failed") if @failed;
    }
}

# t/24data.t
sub subtest_data {
    my ( $theme, $file ) = @_;
    $file = '' if !defined $file;
    _check_file_lines(
        $theme, $file,
        "__DATA__ section for %s",
        sub {
            my @lines;
            my $in_data;
            for my $line (@_) {
                $in_data++ if $line =~ /^__DATA__$/;
                next if !$in_data;
                push @lines, $line
                    if /^#/ && !/^# ?(?:names(?: +[-\w]+)*|default)\s*$/;
            }
            return @lines;
        }
    );
}

sub subtest_version {
    my ($theme) = @_;
    my $tb = __PACKAGE__->builder;
    $tb->plan( tests => 1 );
    no strict 'refs';
    my $version = "Acme::MetaSyntactic::$theme"->VERSION || '';
    $tb->ok( $version, "$theme version $version" );
}

# t/90up2date.t
my ($has_lwp, $has_test_diff, $has_network);
BEGIN {
    $has_lwp     = eval { require LWP::UserAgent; 1; };
    $has_network = $has_lwp
        && LWP::UserAgent->new( timeout => 5, env_proxy => 1 )
                         ->get('http://www.google.com/intl/en/')
                         ->is_success;
};

sub subtest_remote {
    my ($theme) = @_;
    my $class = "Acme::MetaSyntactic::$theme";

    # find out if we're in one of the many cases for skipping
    my $why
        = !$ENV{RELEASE_TESTING}
        && !$ENV{AUTHOR_TESTING}  ? 'Remote list test is RELEASE_TESTING'
        : $ENV{AUTOMATED_TESTING} ? "Remote list test isn't AUTOMATED_TESTING"
        : !$class->has_remotelist ? "Theme $theme does not have a remote list"
        : !$has_lwp               ? 'Remote list test needs LWP::UserAgent'
        : !$has_network           ? 'Remote list test needs network'
        :                           '';

    my $tb    = __PACKAGE__->builder;
    my @metas = _theme_sublists($theme);
    $tb->plan( tests => scalar @metas );

SKIP: {
        if ($why) {
            $tb->skip($why) for 1 .. @metas;
            last SKIP;
        }


        for my $test (@metas) {
            my ( $ams, $theme ) = @$test;

            no warnings 'utf8';
            my $current = [ sort $ams->name(0) ];
            my $remote  = [ sort $ams->remote_list() ];

            if ( !@$remote ) {
                $tb->skip("Fetching remote items for $theme probably failed");
                next;