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