view release on metacpan or  search on metacpan

t/tree.t  view on Meta::CPAN

#! /usr/bin/perl -w
use strict;

use Data::Dumper;
use File::Spec::Functions qw( :DEFAULT abs2rel rel2abs splitpath splitdir );
use File::Find;
use File::Temp 'tempdir';
use Cwd;

use Test::More tests => 22;

# We need to test SourceTree.pm
sub mani_file_from_list($;@) {
    my( $mani_file, @list ) = @_;
    local *MANIFEST;
    open MANIFEST, "> $mani_file" or die "Can't create '$mani_file': $!";
    print MANIFEST "$_\n" for grep length $_ => @list;
    close MANIFEST;
}

sub MANIFEST_from_dir($) {
    my( $path ) = @_;

    my $cwd = cwd();
    chdir $path or die "Cannot chdir($path): $!\n";
    my @files = qw( MANIFEST );

    find sub {
        -f or return;
        $_ eq '.gitignore' and return;
        my $relfile = canonpath( $File::Find::name );
        my( undef, $dirs, $file ) = splitpath( $relfile );
        my @dirs = grep $_ && length $_ => splitdir( $dirs );
        $^O eq 'VMS' and $file =~ s/\.$//;
        push @dirs, $file;
        push @files, join '/', @dirs;
    }, '.';

    chdir $cwd;
    my $mani_file = File::Spec->catfile( $path, 'MANIFEST' );
    mani_file_from_list( $mani_file => @files );
}

BEGIN { use_ok( 'Test::Smoke::SourceTree', ':const' ); }

my $cwd = cwd();
my $tmpdir = tempdir(CLEANUP => $ENV{SMOKE_DEBUG} ? 0 : 1);
my $path = $tmpdir;

{
    my $tree = Test::Smoke::SourceTree->new($tmpdir);
    isa_ok( $tree, 'Test::Smoke::SourceTree' );

    is( $tree->canonpath, File::Spec->canonpath( $path ) , "canonpath" );

    is( $tree->rel2abs, $path, "rel2abs" );
    my $rel = File::Spec->abs2rel( $path );
    is( $tree->abs2rel, $rel, "abs2rel" );

    is( $tree->mani2abs( 'win32/Makefile' ),
        File::Spec->catfile( $path, split m|/|, 'win32/Makefile' ),
        "mani2abs complex" );

}

SKIP: {
    eval { MANIFEST_from_dir($tmpdir) };
    $@ and skip $@, 3;

    my $tree = Test::Smoke::SourceTree->new($tmpdir);
    isa_ok( $tree, 'Test::Smoke::SourceTree' );

    my $mani_check = $tree->check_MANIFEST;

    is( keys %$mani_check, 0, "No dubious files" ) or
        diag Dumper $mani_check;

    my $mani_file = File::Spec->catfile( $tree->canonpath, 'MANIFEST' );

    is( $tree->abs2mani( $mani_file ), 'MANIFEST', "abs2mani" );
    1 while unlink $mani_file;
}

SKIP: { # Check that we can pass extra files to check_MANIFEST()
    eval { MANIFEST_from_dir($tmpdir) };
    $@ and skip $@, 1;

    my $tree = Test::Smoke::SourceTree->new($tmpdir);

    my $mani_check = $tree->check_MANIFEST( 'does_not_exist' );

    is( keys %$mani_check, 0, "No dubious files [skips are not reported]" ) or
        diag Dumper $mani_check;

    my $mani_file = File::Spec->catfile( $tree->canonpath, 'MANIFEST' );
    1 while unlink $mani_file;
}

SKIP: { # Check that check_MANIFEST() finds dubious files
    my $missing = File::Spec->catfile($tmpdir, 'missing');
    $missing = File::Spec->rel2abs( $missing );
    local *FH;
    {
        open FH, "> $missing" or skip "Cannot create '$missing': $!", 3;
        close FH;
    }
    eval { MANIFEST_from_dir($tmpdir) };
    $@ and skip $@, 3;
    1 while unlink $missing;
    my $undeclared = File::Spec->catfile($tmpdir, 'undeclared' );
    $undeclared = File::Spec->rel2abs( $undeclared );
    {
        open FH, "> $undeclared" or skip "Cannot create '$undeclared': $!", 3;
        close FH;
    }
    my $skipit = File::Spec->catfile($tmpdir, 'skip_it');
    $skipit = File::Spec->rel2abs( $skipit );
    {
        open FH, "> $skipit" or skip "Cannot create '$skipit': $!", 3;
        close FH;
    }