[svn:parrot] r37881 - in branches/install_tools: lib/Parrot t/tools/install

[jkeenan at svn.parrot.org]

Author: jkeenan
Date: Fri Apr  3 01:13:10 2009
New Revision: 37881
URL: https://trac.parrot.org/parrot/changeset/37881

Log:
Applying patch submitted by wayland, with revision to exclude Perl 5.10-only features.

Modified:
   branches/install_tools/lib/Parrot/Install.pm
   branches/install_tools/t/tools/install/01-install_files.t

Modified: branches/install_tools/lib/Parrot/Install.pm
==============================================================================
--- branches/install_tools/lib/Parrot/Install.pm	Fri Apr  3 00:00:24 2009	(r37880)
+++ branches/install_tools/lib/Parrot/Install.pm	Fri Apr  3 01:13:10 2009	(r37881)
@@ -68,6 +68,8 @@
     # We'll report multiple occurrences of the same file
     my(%seen);
 
+    ref($manifests) eq 'ARRAY' or die "\$manifests must be an array reference\n";
+    @$manifests > 0 or die "No manifests specified";
     @ARGV = @$manifests;
     LINE: while (<>) {
         chomp;
@@ -89,7 +91,9 @@
         $meta =~ s/^\[(.*?)\]//;
         next unless $package;    # Skip if this file belongs to no package
 
-        my($plist) = $options->{packages};
+        my $plist = defined ( $options->{packages})
+            ? $options->{packages}
+            : '.*';
         next unless $package =~ /$plist/;
 
         my %meta;
@@ -105,7 +109,6 @@
                 );
                 last FIXFILE;
             }
-
             my($copy);
             foreach $tkey (keys %$metatransforms) {
                 if ( $meta{$tkey} ) {
@@ -134,7 +137,7 @@
                     last FIXFILE;
                 }
             }
-            die "Unknown install location in MANIFEST: $_";
+            die "Unknown install location in MANIFEST for file '$_': ";
         }
 
         $dest = File::Spec->catdir( $options->{buildprefix}, $dest )

Modified: branches/install_tools/t/tools/install/01-install_files.t
==============================================================================
--- branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 00:00:24 2009	(r37880)
+++ branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 01:13:10 2009	(r37881)
@@ -6,10 +6,11 @@
 use strict;
 use warnings;
 
-use Test::More tests =>  1;
+use Test::More qw(no_plan); # tests =>  5;
 use Carp;
 use File::Temp qw( tempdir );
 use lib qw( lib );
+use File::Temp qw/ tempdir /;
 use Parrot::Install qw(
     install_files
     create_directories
@@ -45,6 +46,87 @@
 
 =cut
 
+{
+    my($dir) = tempdir( CLEANUP => 1 );
+    $dir .= '/';
+
+    my(@dirs) = qw(foo/bar foo/bar/baz);
+    create_directories($dir, { map { $_ => 1 } @dirs });
+    my($fullname);
+    foreach(@dirs) {
+        $fullname = $dir . $_;
+        -d $fullname or croak "create_directories didn't create directory '$fullname'";
+    }
+    ok(1, 'create_directories passed all tests');
+
+    my($testdir) = $dirs[0];
+    my(@files) = ['README', "$testdir/README"];
+
+    install_files($dir, 1, @files);
+    foreach(@files) {
+        $fullname = $dir . $_->[1];
+        -f "$fullname" and croak "install_files installed file '$fullname' in a dry run";
+    }
+    ok(1, 'install_files passed dry-run test');
+    
+    install_files($dir, 0, @files);
+    foreach(@files) {
+        $fullname = $dir . $_->[1];
+        -f "$fullname" or croak "install_files didn't install file '$fullname'";
+    }
+    ok(1, 'install_files passed all tests');
+}
+
+## Can't safely run lines_to_files() more than once in a program until it's been fixed, 
+## and we can't fix it until its tested, so I've commented most of these out until we've
+## fixed lines_to_files() not to use @ARGV
+{
+    my($metatransforms, $othertransforms, $manifests, $options, $parrotdir,
+        $files, $installable_exe, $directories);
+
+    # First lines_to_files test
+#    eval { lines_to_files(); };
+#    $@ or die "lines_to_files didn't die with no parameters\n";
+#    ok($@ =~ /^.manifests must be an array reference$/, 'lines_to_files dies with bad parameters');
+
+    # Second lines_to_files test
+#    eval { lines_to_files(
+#        $metatransforms, $othertransforms, 
+#        [qw(MANIFEST MANIFEST.generated)], 
+#        $options, $parrotdir
+#    ); };
+#    ok($@ =~ /^Unknown install location in MANIFEST for file/, 'fails for install locations not specified in transforms');
+
+    # Third lines_to_files test
+    $metatransforms = {
+        doc => {
+            optiondir => 'doc',
+            transform => sub {
+                my($dest) = @_;
+                $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
+                $dest =~ s/^docs/pod/; # other docs are actually raw Pod
+                $parrotdir, $dest;
+            },
+        },
+    };
+    $othertransforms = {
+        '.*' => {
+            optiondir => 'foo',
+            transform => sub {
+                return(@_);
+            }
+        }
+    };
+
+    ($files, $installable_exe, $directories) = lines_to_files(
+        $metatransforms, $othertransforms, 
+        [qw(MANIFEST MANIFEST.generated)], 
+        { packages => 'main' }, $parrotdir
+    );
+    ok((ref($files) and ref($installable_exe) and ref($directories)), 'lines_to_files returns something vaguely sensible');
+    ok(1, 'lines_to_files passed all tests');
+}
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4