[svn:parrot] r37884 - branches/install_tools/t/tools/install

jkeenan at svn.parrot.org jkeenan at svn.parrot.org
Fri Apr 3 02:41:08 UTC 2009


Author: jkeenan
Date: Fri Apr  3 02:41:07 2009
New Revision: 37884
URL: https://trac.parrot.org/parrot/changeset/37884

Log:
Beginning to extend test coverage of Parrot::Install subroutines.

Modified:
   branches/install_tools/t/tools/install/01-install_files.t

Modified: branches/install_tools/t/tools/install/01-install_files.t
==============================================================================
--- branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 02:40:31 2009	(r37883)
+++ branches/install_tools/t/tools/install/01-install_files.t	Fri Apr  3 02:41:07 2009	(r37884)
@@ -6,11 +6,11 @@
 use strict;
 use warnings;
 
-use Test::More qw(no_plan); # tests =>  5;
+use Test::More tests =>  8;
 use Carp;
+use Cwd;
 use File::Temp qw( tempdir );
 use lib qw( lib );
-use File::Temp qw/ tempdir /;
 use Parrot::Install qw(
     install_files
     create_directories
@@ -18,8 +18,6 @@
 );
 use IO::CaptureOutput qw( capture );
 
-pass("Completed all tests in $0");
-
 ################### DOCUMENTATION ###################
 
 =head1 NAME
@@ -46,100 +44,121 @@
 
 =cut
 
+my $cwd = cwd();
+
 {
     my $dir = tempdir( CLEANUP => 1 );
     $dir .= '/';
 
     my @dirs = qw(foo/bar foo/bar/baz);
     create_directories($dir, { map { $_ => 1 } @dirs });
-    my($fullname);
-    my $dirs_created = 0;
+    my $dirs_seen = 0;
     foreach my $d (@dirs) {
-        $dirs_created++ if -d "$dir$d";
+        $dirs_seen++ if -d "$dir$d";
     }
-    is($dirs_created, 2, 'got expected number of directories created');
+    is($dirs_seen, 2, 'got expected number of directories created');
 }
 
 {
-    my($dir) = tempdir( CLEANUP => 1 );
+    my $dir = tempdir( CLEANUP => 1 );
     $dir .= '/';
 
-    my(@dirs) = qw(foo/bar foo/bar/baz);
+    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"];
+    my @files = ( ['README', "$dirs[0]/README"] );
+
+    {
+        my ( $stdout, $stderr, $rv );
+        capture(
+            sub { $rv = install_files($dir, 1, @files); },
+            \$stdout,
+            \$stderr,
+        );
+        ok( $rv, 'install_files() completed successfully in dry-run case' );
+    
+        my $files_created = 0;
+        foreach my $el (@files) {
+            $files_created++ if -f "$dir$el->[1]";
+        }
+        is( $files_created, 0, 'dry-run, so no files created' );
 
-    install_files($dir, 1, @files);
-    foreach(@files) {
-        $fullname = $dir . $_->[1];
-        -f "$fullname" and croak "install_files installed file '$fullname' in a dry run";
+        like( $stdout, qr/Installing.*README.*README/s,
+            'got expected installation message' );
     }
-    ok(1, 'install_files passed dry-run test');
+
+    {
+        my ( $stdout, $stderr, $rv );
+        capture(
+            sub { $rv = install_files($dir, 0, @files); },
+            \$stdout,
+            \$stderr,
+        );
+        ok( $rv, 'install_files() completed successfully in production case' );
     
-    install_files($dir, 0, @files);
-    foreach(@files) {
-        $fullname = $dir . $_->[1];
-        -f "$fullname" or croak "install_files didn't install file '$fullname'";
+        my $files_created = 0;
+        foreach my $el (@files) {
+            $files_created++ if -f "$dir$el->[1]";
+        }
+        is( $files_created, 1, 'production, so 1 file created' );
+
+        like( $stdout, qr/Installing.*README/s,
+            'got expected installation message' );
     }
-    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(
+#{
+#    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)], 
-#        $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(@_);
-            }
-        }
-    };
+#        { 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');
+#}
 
-    ($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');
-}
+pass("Completed all tests in $0");
 
 # Local Variables:
 #   mode: cperl


More information about the parrot-commits mailing list