view release on metacpan or  search on metacpan

t/01-pptest.t  view on Meta::CPAN

}

eval { is ''.or2(pdl(1), pdl(1), 0), '1' };
is $@, '';

eval { ldouble(4)->logadd(3) };
is $@, '';

undef $main::FOOTERVAL;
undef $main::DelayVAL;
ftr(1, "file");
is $main::FOOTERVAL, 1;
is $main::DelayVAL, 4;

undef $main::HEADERVAL;
undef $main::FOOTERVAL;
ftrPM(1);
is $main::HEADERVAL, 1;
is $main::FOOTERVAL, 1;

done_testing;
EOF

);

do_tests(\%PPTESTFILES);

sub do_tests {
    my ($hash, $error_re, $dir) = @_;
    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}, $error_re);
        },
        $dir,
    );
}

sub run_ok {
    my ($cmd, $error_re) = @_;
    my $res = run(command => $cmd, buffer => \my $buffer);
    if ($error_re) {
        ok !$res, 'Fails to build if invalid';
        like $buffer, $error_re, 'Fails with expected error';
        return;
    }
    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;
    my $dir = shift || File::Spec->catdir(File::Spec->curdir, './.pptest/sub'); # /sub is so top Makefile.PL no see as subdir
    mkpath $dir;
    # 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;
}

done_testing;