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

[jkeenan at svn.parrot.org]

Author: jkeenan
Date: Fri Apr  3 10:52:50 2009
New Revision: 37886
URL: https://trac.parrot.org/parrot/changeset/37886

Log:
Eliminate unreachable condition in create_directories().  Make some variable names more self-documenting.

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:36:00 2009	(r37885)
+++ branches/install_tools/lib/Parrot/Install.pm	Fri Apr  3 10:52:50 2009	(r37886)
@@ -173,19 +173,18 @@
 
 sub create_directories {
     my($destdir, $directories) = @_;
-#    my($dir, @dirs);
 
     for my $dir ( map { $destdir . $_ } keys %$directories ) {
         unless ( -d $dir ) {
-            my @dirs;
+            my @dirs_needed;
 
             # Make full path to the directory $dir
             while ( ! -d $dir ) {    # Scan up to nearest existing ancestor
-                unshift @dirs, $dir;
+                unshift @dirs_needed, $dir;
                 $dir = dirname($dir);
             }
-            foreach my $d (@dirs) {
-                -d $d or mkdir( $d, 0777 ) or die "mkdir $d: $!";
+            foreach my $d ( @dirs_needed ) {
+                mkdir( $d, 0777 ) or die "mkdir $d: $!";
             }
         }
     }

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:36:00 2009	(r37885)
+++ branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 10:52:50 2009	(r37886)
@@ -45,42 +45,60 @@
 =cut
 
 {
-    my $dir = tempdir( CLEANUP => 1 );
-    $dir .= '/';
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
 
     my @dirs = qw(foo/bar foo/bar/baz);
-    create_directories($dir, { map { $_ => 1 } @dirs });
+    create_directories($tdir, { map { $_ => 1 } @dirs });
     my $dirs_seen = 0;
     foreach my $d (@dirs) {
-        $dirs_seen++ if -d "$dir$d";
+        $dirs_seen++ if -d "$tdir$d";
     }
     is($dirs_seen, 2, 'got expected number of directories created');
 }
 
 {
-    my $dir = tempdir( CLEANUP => 1 );
-    $dir .= '/';
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
 
     my @dirs = qw(foo/bar foo/bar/baz);
-    my @created = mkpath( "$dir$dirs[0]" );
+    my @created = mkpath( "$tdir$dirs[0]" );
     ok( ( -d $created[0] ),
         "one directory created before create_directories() is called" );
 
-    create_directories($dir, { map { $_ => 1 } @dirs });
+    create_directories($tdir, { map { $_ => 1 } @dirs });
     my $dirs_seen = 0;
     foreach my $d (@dirs) {
-        $dirs_seen++ if -d "$dir$d";
+        $dirs_seen++ if -d "$tdir$d";
     }
     is($dirs_seen, 2,
         "create_directories() handled case where one directory already existed" );
 }
 
 {
-    my $dir = tempdir( CLEANUP => 1 );
-    $dir .= '/';
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
 
     my @dirs = qw(foo/bar foo/bar/baz);
-    create_directories($dir, { map { $_ => 1 } @dirs });
+    my @created = mkpath( $tdir . 'foo' );
+    ok( ( -d $created[0] ),
+        "one directory created before create_directories() is called" );
+
+    create_directories($tdir, { map { $_ => 1 } @dirs });
+    my $dirs_seen = 0;
+    foreach my $d (@dirs) {
+        $dirs_seen++ if -d "$tdir$d";
+    }
+    is($dirs_seen, 2,
+        "create_directories() handled case where one path partially existed" );
+}
+
+{
+    my $tdir = tempdir( CLEANUP => 1 );
+    $tdir .= '/';
+
+    my @dirs = qw(foo/bar foo/bar/baz);
+    create_directories($tdir, { map { $_ => 1 } @dirs });
     my($fullname);
 
     my @files = ( ['README', "$dirs[0]/README"] );
@@ -88,7 +106,7 @@
     {
         my ( $stdout, $stderr, $rv );
         capture(
-            sub { $rv = install_files($dir, 1, @files); },
+            sub { $rv = install_files($tdir, 1, @files); },
             \$stdout,
             \$stderr,
         );
@@ -96,7 +114,7 @@
     
         my $files_created = 0;
         foreach my $el (@files) {
-            $files_created++ if -f "$dir$el->[1]";
+            $files_created++ if -f "$tdir$el->[1]";
         }
         is( $files_created, 0, 'dry-run, so no files created' );
 
@@ -107,7 +125,7 @@
     {
         my ( $stdout, $stderr, $rv );
         capture(
-            sub { $rv = install_files($dir, 0, @files); },
+            sub { $rv = install_files($tdir, 0, @files); },
             \$stdout,
             \$stderr,
         );
@@ -115,7 +133,7 @@
     
         my $files_created = 0;
         foreach my $el (@files) {
-            $files_created++ if -f "$dir$el->[1]";
+            $files_created++ if -f "$tdir$el->[1]";
         }
         is( $files_created, 1, 'production, so 1 file created' );