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

[jkeenan at svn.parrot.org]

Author: jkeenan
Date: Fri Apr  3 11:12:18 2009
New Revision: 37887
URL: https://trac.parrot.org/parrot/changeset/37887

Log:
Tighten test of variable in install_files().  Test previously untested
branches in install_files().

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 10:52:50 2009	(r37886)
+++ branches/install_tools/lib/Parrot/Install.pm	Fri Apr  3 11:12:18 2009	(r37887)
@@ -216,7 +216,7 @@
 
     print("Installing ...\n");
     foreach my $el ( @files ) {
-        next unless $el;
+        next unless ref($el) eq 'ARRAY';
         ( $src, $dest ) = @{ $el };
         $dest = $destdir . $dest;
         if ( $dryrun ) {

Modified: branches/install_tools/t/tools/install/01-install_files.t
==============================================================================
--- branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 10:52:50 2009	(r37886)
+++ branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 11:12:18 2009	(r37887)
@@ -142,6 +142,57 @@
     }
 }
 
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
+
+    my @dirs = qw(foo/bar foo/bar/baz);
+    create_directories($tdir, { map { $_ => 1 } @dirs });
+    my($fullname);
+
+    # Case where element in @files is not an array ref
+    my @files = ( q{} );
+
+    {
+        my ( $stdout, $stderr, $rv );
+        capture(
+            sub { $rv = install_files($tdir, 0, @files); },
+            \$stdout,
+            \$stderr,
+        );
+        ok( $rv, 'install_files() handled invalid argument as expected' );
+    
+        like( $stdout, qr/Installing \.\.\./, 
+            'got expected installation message' );
+    }
+}
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
+
+    my @dirs = qw(foo/bar foo/bar/baz);
+    create_directories($tdir, { map { $_ => 1 } @dirs });
+    my($fullname);
+
+    # Case where element in @files does not hold existent file
+    my $nonexistent = q{ajdpfadksjfjvjkvds} . $$;
+    my @files = ( [ $nonexistent, "$dirs[0]/$nonexistent"] );
+
+    {
+        my ( $stdout, $stderr, $rv );
+        capture(
+            sub { $rv = install_files($tdir, 0, @files); },
+            \$stdout,
+            \$stderr,
+        );
+        ok( $rv, 'install_files() handled non-existent file as expected' );
+    
+        like( $stdout, qr/Installing \.\.\./, 
+            'got expected installation message' );
+    }
+}
+
 ## 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