Author: jkeenan
Date: Fri Jan 18 18:45:20 2008
New Revision: 24982
Modified:
branches/revision/lib/Parrot/Revision.pm
branches/revision/t/configure/017-revision_no_DEVELOPING.t
branches/revision/t/configure/018-revision.t
Log:
Rewrite tests for Parrot::Revision. Refactor lib/Parrot/Revision.pm to extract
code into internal sub.
Modified: branches/revision/lib/Parrot/Revision.pm
==============================================================================
--- branches/revision/lib/Parrot/Revision.pm (original)
+++ branches/revision/lib/Parrot/Revision.pm Fri Jan 18 18:45:20 2008
@@ -23,10 +23,11 @@
use warnings;
use File::Spec;
-my $cache = q{.parrot_current_rev};
+our $cache = q{.parrot_current_rev};
-sub _get_revision {
+our $current = _get_revision();
+sub _get_revision {
my $revision;
if (-f $cache) {
eval {
@@ -37,6 +38,20 @@
return $revision unless $@;
}
+ $revision = _analyze_sandbox();
+
+ unless (-f $cache) {
+ eval {
+ open my $FH, ">", $cache;
+ print $FH "$revision\n";
+ close $FH;
+ };
+ }
+ return $revision;
+}
+
+sub _analyze_sandbox {
+ my $revision = 0;
# code taken from pugs/util/version_h.pl rev 14410
my $nul = File::Spec->devnull;
if ( my @svn_info = qx/svn --xml info 2>$nul/ and $? == 0 ) {
@@ -66,19 +81,9 @@
}
}
}
- $revision ||= 0;
- unless (-f $cache) {
- eval {
- open my $FH, ">", $cache;
- print $FH "$revision\n";
- close $FH;
- };
- }
return $revision;
}
-our $current = _get_revision();
-
1;
# Local Variables:
Modified: branches/revision/t/configure/017-revision_no_DEVELOPING.t
==============================================================================
--- branches/revision/t/configure/017-revision_no_DEVELOPING.t (original)
+++ branches/revision/t/configure/017-revision_no_DEVELOPING.t Fri Jan 18
18:45:20 2008
@@ -6,42 +6,39 @@
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More tests => 7;
use Carp;
-use_ok('Cwd');
-use_ok('File::Copy');
-use_ok( 'File::Temp', qw| tempdir | );
+use Cwd;
+use File::Copy;
+use File::Path ();
+use File::Temp qw| tempdir |;
use lib qw( lib );
-my ( $current, $config );
-
-# Case 2: DEVELOPING's non-existence is faked; Parrot::Config not yet
available. #'
my $cwd = cwd();
-my $reason =
-'Either file DEVELOPING does not exist or configuration has completed (as
evidenced by existence of Parrot::Config::Generated';
-
-SKIP: {
- skip $reason, 7 if ( ( not -e 'DEVELOPING' )
- or ( -e q{lib/Parrot/Config/Generated.pm} ) );
+{
+ my $rev = 16000;
my $tdir = tempdir( CLEANUP => 1 );
ok( chdir $tdir, "Changed to temporary directory for testing" );
- ok( ( mkdir "lib" ), "Able to make directory lib" );
- ok( ( mkdir "lib/Parrot" ), "Able to make directory lib/Parrot" );
- ok(
- copy( "$cwd/lib/Parrot/Revision.pm", "lib/Parrot/" ),
- "Able to copy Parrot::Revision for testing"
- );
- unshift( @INC, "lib" );
+ my $libdir = qq{$tdir/lib};
+ ok( (File::Path::mkpath( $libdir )), "Able to make libdir");
+ local @INC;
+ unshift @INC, $libdir;
+ ok( (File::Path::mkpath( qq{$libdir/Parrot} )), "Able to make Parrot dir");
+ ok( (copy qq{$cwd/lib/Parrot/Revision.pm},
+ qq{$libdir/Parrot}), "Able to copy Parrot::Revision");
+ my $cache = q{.parrot_current_rev};
+ open my $FH, ">", $cache
+ or croak "Unable to open $cache for writing";
+ print $FH qq{$rev\n};
+ close $FH or croak "Unable to close $cache after writing";
require Parrot::Revision;
- no warnings qw(once);
- $current = $Parrot::Revision::current;
- like( $current, qr/^\d+$/, "current revision is all numeric" );
+ no warnings 'once';
+ is($Parrot::Revision::current, $rev,
+ "Got expected revision number from cache");
use warnings;
- is( $current, 0, 'current is zero as expected' );
- ok( chdir $cwd, "Able to change back to directory after testing" );
+ ok( chdir $cwd, "Able to change back to starting directory");
}
-# Case 3: DEVELOPING exists; Parrot::Config available.
pass("Completed all tests in $0");
################### DOCUMENTATION ###################
Modified: branches/revision/t/configure/018-revision.t
==============================================================================
--- branches/revision/t/configure/018-revision.t (original)
+++ branches/revision/t/configure/018-revision.t Fri Jan 18 18:45:20 2008
@@ -6,25 +6,34 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 8;
use Carp;
-use_ok('Cwd');
-use_ok('File::Copy');
-use_ok( 'File::Temp', qw| tempdir | );
+use Cwd;
+use File::Copy;
+use File::Path ();
+use File::Temp qw| tempdir |;
use lib qw( lib );
-use Parrot::Revision;
-my ( $current, $config );
-
-# Case 1: DEVELOPING exists; Parrot::Config not yet available.
-my $reason =
-'Either file DEVELOPING does not exist, or configuration has completed
(because Parrot::Config::Generated exists).';
-SKIP: {
- skip $reason, 1 if ( ( not -e 'DEVELOPING' )
- or ( -e q{lib/Parrot/Config/Generated.pm} ) );
- $current = $Parrot::Revision::current;
- like( $current, qr/^\d+$/, "current revision is all numeric" );
-} # end SKIP block
+my $cwd = cwd();
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ ok( chdir $tdir, "Changed to temporary directory for testing" );
+ my $libdir = qq{$tdir/lib};
+ ok( (File::Path::mkpath( $libdir )), "Able to make libdir");
+ local @INC;
+ unshift @INC, $libdir;
+ ok( (File::Path::mkpath( qq{$libdir/Parrot} )), "Able to make Parrot dir");
+ ok( (copy qq{$cwd/lib/Parrot/Revision.pm},
+ qq{$libdir/Parrot}), "Able to copy Parrot::Revision");
+ require Parrot::Revision;
+ no warnings 'once';
+ like($Parrot::Revision::current, qr/^\d+$/,
+ "Got numeric value for reversion number");
+ use warnings;
+ my $cache = q{.parrot_current_rev};
+ ok( ( -e $cache ), "Cache for revision number was created");
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
pass("Completed all tests in $0");
