Here's the attachment.
Index: lib/Parrot/Revision.pm
===================================================================
--- lib/Parrot/Revision.pm (.../trunk) (revision 29567)
+++ lib/Parrot/Revision.pm (.../branches/revisionpm) (revision 29574)
@@ -30,36 +30,50 @@
sub update {
my $prev = _get_revision();
my $revision = _analyze_sandbox();
- if (defined ($prev) && ($revision ne $prev)) {
- $revision = 'unknown' unless defined $revision;
- eval {
- open my $FH, ">", $cache;
- print $FH "$revision\n";
- close $FH;
- $current = $revision;
- };
+ $current = _handle_update( {
+ prev => $prev,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+}
+
+sub _handle_update {
+ my $args = shift;
+ if (! defined $args->{revision}) {
+ $args->{revision} = 'unknown';
+ _print_to_cache($args->{cache}, $args->{revision});
+ return $args->{revision};
+ } else {
+ if (defined ($args->{prev}) && ($args->{revision} ne $args->{prev})) {
+ _print_to_cache($args->{cache}, $args->{revision});
+ return $args->{revision};
+ }
+ else {
+ return $args->{current};
+ }
}
}
+sub _print_to_cache {
+ my ($cache, $revision) = @_;
+ open my $FH, ">", $cache
+ or die "Unable to open handle to $cache for writing: $!";
+ print $FH "$revision\n";
+ close $FH or die "Unable to close handle to $cache after writing: $!";
+}
+
sub _get_revision {
my $revision;
if (-f $cache) {
- eval {
- open my $FH, "<", $cache;
- chomp($revision = <$FH>);
- close $FH;
- };
- return $revision unless $@;
+ open my $FH, "<", $cache
+ or die "Unable to open $cache for reading: $!";
+ chomp($revision = <$FH>);
+ close $FH or die "Unable to close $cache after reading: $!";
}
-
- $revision = _analyze_sandbox();
-
- if (! -f $cache) {
- eval {
- open my $FH, ">", $cache;
- print $FH "$revision\n";
- close $FH;
- };
+ else {
+ $revision = _analyze_sandbox();
+ _print_to_cache($cache, $revision);
}
return $revision;
}
Index: MANIFEST
===================================================================
--- MANIFEST (.../trunk) (revision 29567)
+++ MANIFEST (.../branches/revisionpm) (revision 29574)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 15 23:45:17 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Jul 17 22:40:30 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -3338,6 +3338,7 @@
t/configure/058-fatal_step.t []
t/configure/059-silent.t []
t/configure/060-silent.t []
+t/configure/061-revision_from_cache.t []
t/configure/testlib/Make_VERSION_File.pm []
t/configure/testlib/Tie/Filehandle/Preempt/Stdin.pm []
t/configure/testlib/init/alpha.pm []
Index: t/configure/061-revision_from_cache.t
===================================================================
--- t/configure/061-revision_from_cache.t (.../trunk) (revision 0)
+++ t/configure/061-revision_from_cache.t (.../branches/revisionpm)
(revision 29574)
@@ -0,0 +1,148 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id$
+# 061-revision_from_cache.t
+
+use strict;
+use warnings;
+
+use Test::More;
+plan( skip_all => "\nRelevant only when working in checkout from repository
and during configuration" )
+ unless (-e 'DEVELOPING' and ! -e 'Makefile');
+plan( tests => 25 );
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Path ();
+use File::Temp qw| tempdir |;
+use lib qw( lib );
+use Parrot::Revision ();
+
+my $cwd = cwd();
+{ # revision undef
+ my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ my $prev = 34567;
+ my $revision = undef;
+ my $current = 12345;
+ my $ret = Parrot::Revision::_handle_update( {
+ prev => $prev,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+ is($ret, q{unknown}, "Got expected return value from _handle_update");
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+{ # prev undef
+ my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ my $revision = 67890;
+ my $current = 12345;
+ my $ret = Parrot::Revision::_handle_update( {
+ prev => undef,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+ is($ret, $current, "Got expected return value from _handle_update");
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+{ # prev and revision both defined and identical
+ my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ my $prev = 67890;
+ my $revision = 67890;
+ my $current = 12345;
+ my $ret = Parrot::Revision::_handle_update( {
+ prev => $prev,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+ is($ret, $current, "Got expected return value from _handle_update");
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+{ # prev and revision both defined but not identical
+ my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ my $prev = 67890;
+ my $revision = 67891;
+ my $current = 12345;
+ my $ret = Parrot::Revision::_handle_update( {
+ prev => $prev,
+ revision => $revision,
+ cache => $cache,
+ current => $current,
+ } );
+ is($ret, $revision, "Got expected return value from _handle_update");
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+
+##### SUBROUTINES #####
+
+sub setup_cache {
+ my ($rev, $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");
+ 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";
+ return ($cache, $libdir);
+}
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+061-revision_from_cache.t - test Parrot::Revision
+
+=head1 SYNOPSIS
+
+ % prove t/configure/061-revision_from_cache.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by F<Configure.pl>.
+
+The tests in this file test Parrot::Revision (F<lib/Parrot/Revision.pm>).
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+Parrot::Configure, F<Configure.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: t/configure/061-revision_from_cache.t
___________________________________________________________________
Name: svn:eol-style
+ native
Name: svn:mime-type
+ text/plain
Name: svn:keywords
+ Author Date Id Revision
Index: t/configure/017-revision_from_cache.t
===================================================================
--- t/configure/017-revision_from_cache.t (.../trunk) (revision 29567)
+++ t/configure/017-revision_from_cache.t (.../branches/revisionpm)
(revision 29574)
@@ -20,6 +20,23 @@
my $cwd = cwd();
{
my $rev = 16000;
+ my ($cache, $libdir) = setup_cache($rev, $cwd);
+ require Parrot::Revision;
+ no warnings 'once';
+ is($Parrot::Revision::current, $rev,
+ "Got expected revision number from cache");
+ use warnings;
+ unlink qq{$libdir/Parrot/Revision.pm}
+ or croak "Unable to delete file after testing";
+ ok( chdir $cwd, "Able to change back to starting directory");
+}
+
+pass("Completed all tests in $0");
+
+##### SUBROUTINES #####
+
+sub setup_cache {
+ my ($rev, $cwd) = @_;
my $tdir = tempdir( CLEANUP => 1 );
ok( chdir $tdir, "Changed to temporary directory for testing" );
my $libdir = qq{$tdir/lib};
@@ -34,18 +51,9 @@
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 'once';
- is($Parrot::Revision::current, $rev,
- "Got expected revision number from cache");
- use warnings;
- unlink qq{$libdir/Parrot/Revision.pm}
- or croak "Unable to delete file after testing";
- ok( chdir $cwd, "Able to change back to starting directory");
+ return ($cache, $libdir);
}
-pass("Completed all tests in $0");
-
################### DOCUMENTATION ###################
=head1 NAME
