view release on metacpan or  search on metacpan

t/pptest.t  view on Meta::CPAN

    int inw = $PDLA(work)->dims[0];
    $SIZE(wn) = inw >= min ? inw : min;',
	OtherPars => 'int flags;',
    Code => 'int foo = 1;  ');

pp_done();
EOF

    't/all.t' => <<'EOF',
use strict;
use warnings;
use Test::More tests => 1;
use PDLA::LiteF;
use_ok 'PDLA::Otherpars';
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;
}