Ticket #426: parrot_install_tools_tests.patch

File parrot_install_tools_tests.patch, 4.5 KB (added by wayland, 13 years ago)

Just tests this time

  • lib/Parrot/Install.pm

     
    6868    # We'll report multiple occurrences of the same file 
    6969    my(%seen); 
    7070 
     71    ref($manifests) eq 'ARRAY' or die "\$manifests must be an array reference\n"; 
     72    @$manifests > 0 or die "No manifests specified"; 
    7173    @ARGV = @$manifests; 
    7274    LINE: while (<>) { 
    7375        chomp; 
    … …  
    9092        next unless $package;    # Skip if this file belongs to no package 
    9193 
    9294        my($plist) = $options->{packages}; 
     95        $plist //= '.*'; 
    9396        next unless $package =~ /$plist/; 
    9497 
    9598        my %meta; 
    … …  
    105108                ); 
    106109                last FIXFILE; 
    107110            } 
    108  
    109111            my($copy); 
    110112            foreach $tkey (keys %$metatransforms) { 
    111113                if ( $meta{$tkey} ) { 
    … …  
    134136                    last FIXFILE; 
    135137                } 
    136138            } 
    137             die "Unknown install location in MANIFEST: $_"; 
     139            die "Unknown install location in MANIFEST for file '$_': "; 
    138140        } 
    139141 
    140142        $dest = File::Spec->catdir( $options->{buildprefix}, $dest ) 

  • t/tools/install/01-install_files.t

     
    66use strict; 
    77use warnings; 
    88 
    9 use Test::More tests =>  1; 
     9use Test::More tests =>  5; 
    1010use Carp; 
    1111use File::Temp qw( tempdir ); 
    1212use lib qw( lib ); 
     13use File::Temp qw/ tempdir /; 
    1314use Parrot::Install qw( 
    1415    install_files 
    1516    create_directories 
    … …  
    4546 
    4647=cut 
    4748 
     49{ 
     50    my($dir) = tempdir( CLEANUP => 1 ); 
     51    $dir .= '/'; 
     52 
     53    my(@dirs) = qw(foo/bar foo/bar/baz); 
     54    create_directories($dir, { map { $_ => 1 } @dirs }); 
     55    my($fullname); 
     56    foreach(@dirs) { 
     57        $fullname = $dir . $_; 
     58        -d $fullname or croak "create_directories didn't create directory '$fullname'"; 
     59    } 
     60    ok(1, 'create_directories passed all tests'); 
     61 
     62    my($testdir) = $dirs[0]; 
     63    my(@files) = ['README', "$testdir/README"]; 
     64 
     65    install_files($dir, 1, @files); 
     66    foreach(@files) { 
     67        $fullname = $dir . $_->[1]; 
     68        -f "$fullname" and croak "install_files installed file '$fullname' in a dry run"; 
     69    } 
     70    ok(1, 'install_files passed dry-run test'); 
     71     
     72    install_files($dir, 0, @files); 
     73    foreach(@files) { 
     74        $fullname = $dir . $_->[1]; 
     75        -f "$fullname" or croak "install_files didn't install file '$fullname'"; 
     76    } 
     77    ok(1, 'install_files passed all tests'); 
     78} 
     79 
     80## Can't safely run lines_to_files() more than once in a program until it's been fixed,  
     81## and we can't fix it until its tested, so I've commented most of these out until we've 
     82## fixed lines_to_files() not to use @ARGV 
     83{ 
     84    my($metatransforms, $othertransforms, $manifests, $options, $parrotdir, 
     85        $files, $installable_exe, $directories); 
     86 
     87    # First lines_to_files test 
     88#    eval { lines_to_files(); }; 
     89#    $@ or die "lines_to_files didn't die with no parameters\n"; 
     90#    ok($@ =~ /^.manifests must be an array reference$/, 'lines_to_files dies with bad parameters'); 
     91 
     92    # Second lines_to_files test 
     93#    eval { lines_to_files( 
     94#        $metatransforms, $othertransforms,  
     95#        [qw(MANIFEST MANIFEST.generated)],  
     96#        $options, $parrotdir 
     97#    ); }; 
     98#    ok($@ =~ /^Unknown install location in MANIFEST for file/, 'fails for install locations not specified in transforms'); 
     99 
     100    # Third lines_to_files test 
     101    $metatransforms = { 
     102        doc => { 
     103            optiondir => 'doc', 
     104            transform => sub { 
     105                my($dest) = @_; 
     106                $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs 
     107                $dest =~ s/^docs/pod/; # other docs are actually raw Pod 
     108                $parrotdir, $dest; 
     109            }, 
     110        }, 
     111    }; 
     112    $othertransforms = { 
     113        '.*' => { 
     114            optiondir => 'foo', 
     115            transform => sub { 
     116                return(@_); 
     117            } 
     118        } 
     119    }; 
     120 
     121    ($files, $installable_exe, $directories) = lines_to_files( 
     122        $metatransforms, $othertransforms,  
     123        [qw(MANIFEST MANIFEST.generated)],  
     124        { packages => 'main' }, $parrotdir 
     125    ); 
     126    ok((ref($files) and ref($installable_exe) and ref($directories)), 'lines_to_files returns something vaguely sensible'); 
     127    ok(1, 'lines_to_files passed all tests'); 
     128} 
     129 
    48130# Local Variables: 
    49131#   mode: cperl 
    50132#   cperl-indent-level: 4