view release on metacpan or  search on metacpan

t/pptest.t  view on Meta::CPAN

# Test the inability to comment-out a threadloop. This is documented on the
# 11th page of the PDLA::PP chapter of the PDLA book. If somebody ever fixes this
# wart, this test will fail, in which case the book's text should be updated.
$y = $x->testinc2;
TODO: {
        # Note: This test appears to fail on Cygwin and some flavors of Linux.
        local $TODO = 'This test inexplicably passes on some machines';
        ok(not (all $y == $x + 1), 'WART: commenting out a threadloop does not work')
                or diag("\$x is $x and \$y is $y");
}
}

done_testing;
EOF

);

do_tests(\%PPTESTFILES);
in_dir(
    sub {
        hash2files(File::Spec->curdir, \%OTHERPARSFILES);
        local $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
        run_ok(qq{"$^X" Makefile.PL});
        my $cmd = qq{"$Config{make}" test};
        my $buffer;
        my $res = run(command => $cmd, buffer => \$buffer);
        ok !$res, 'Fails to build if invalid';
        like $buffer, qr/Invalid OtherPars name/, 'Fails if given invalid OtherPars name';
    },
);

sub do_tests {
    my ($hash) = @_;
    in_dir(
        sub {
            hash2files(File::Spec->curdir, $hash);
            local $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
            run_ok(qq{"$^X" Makefile.PL});
            run_ok(qq{"$Config{make}" test});
        },
    );
}

sub run_ok {
    my ($cmd) = @_;
    my $buffer;
    my $res = run(command => $cmd, buffer => \$buffer);
    if (!$res) {
        ok 0, $cmd;
        diag $buffer;
        return;
    }
    ok 1, $cmd;
}

sub hash2files {
    my ($prefix, $hashref) = @_;
    while(my ($file, $text) = each %$hashref) {
        # Convert to a relative, native file path.
        $file = File::Spec->catfile(File::Spec->curdir, $prefix, split m{\/}, $file);
        my $dir = dirname($file);
        mkpath $dir;
        my $utf8 = ($] < 5.008 or !$Config{useperlio}) ? "" : ":utf8";
        open(my $fh, ">$utf8", $file) || die "Can't create $file: $!";
        print $fh $text;
        close $fh;
    }
}

sub in_dir {
    my $code = shift;
    require File::Temp;
    my $dir = shift || File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1);
    # chdir to the new directory
    my $orig_dir = getcwd();
    chdir $dir or die "Can't chdir to $dir: $!";
    # Run the code, but trap the error so we can chdir back
    my $return;
    my $ok = eval { $return = $code->(); 1; };
    my $err = $@;
    # chdir back
    chdir $orig_dir or die "Can't chdir to $orig_dir: $!";
    # rethrow if necessary
    die $err unless $ok;
    return $return;
}