Revision 29660

Date:
2008/07/22 01:22:08
Author:
jkeenan
Revision Log:
Merge revisionpm branch into trunk. Cf.:
http://rt.perl.org/rt3/Ticket/Display.html?id=56948. Refactor
Parrot::Revision and add tests, including one new test file.
Files:

Legend:

 
Added
 
Removed
 
Modified

  • trunk/lib/Parrot/Configure/Options/Test.pm

     
    85 85 my $self = shift;
    86 86 my @preconfiguration_tests = @_;
    87 87 if ( $self->get_run('run_configure_tests') ) {
    88 my $start = time();
    88 89 print "As you requested, we'll start with some tests of the configuration tools.\n\n";
    89 90
    90 91 runtests(@preconfiguration_tests) or die
    … …  
    95 96 Parrot's configuration tools will work as intended.
    96 97
    97 98 TEST
    99 my $end =time();
    100 print scalar(@preconfiguration_tests),
    101 " t/configure and t/step tests took ",
    102 ($end - $start), " seconds.\n";
    98 103 }
    99 104 return 1;
    100 105 }

  • trunk/lib/Parrot/Revision.pm

     
    30 30 sub update {
    31 31 my $prev = _get_revision();
    32 32 my $revision = _analyze_sandbox();
    33 if (defined ($prev) && ($revision ne $prev)) {
    34 $revision = 'unknown' unless defined $revision;
    35 eval {
    36 open my $FH, ">", $cache;
    37 print $FH "$revision\n";
    38 close $FH;
    39 $current = $revision;
    40 };
    33 $current = _handle_update( {
    34 prev => $prev,
    35 revision => $revision,
    36 cache => $cache,
    37 current => $current,
    38 } );
    39 }
    40
    41 sub _handle_update {
    42 my $args = shift;
    43 if (! defined $args->{revision}) {
    44 $args->{revision} = 'unknown';
    45 _print_to_cache($args->{cache}, $args->{revision});
    46 return $args->{revision};
    41 47 }
    48 else {
    49 if (defined ($args->{prev}) && ($args->{revision} ne $args->{prev})) {
    50 _print_to_cache($args->{cache}, $args->{revision});
    51 return $args->{revision};
    52 }
    53 else {
    54 return $args->{current};
    55 }
    56 }
    42 57 }
    43 58
    59 sub _print_to_cache {
    60 my ($cache, $revision) = @_;
    61 open my $FH, ">", $cache
    62 or die "Unable to open handle to $cache for writing: $!";
    63 print $FH "$revision\n";
    64 close $FH or die "Unable to close handle to $cache after writing: $!";
    65 }
    66
    44 67 sub _get_revision {
    45 68 my $revision;
    46 69 if (-f $cache) {
    47 eval {
    48 open my $FH, "<", $cache;
    49 chomp($revision = <$FH>);
    50 close $FH;
    51 };
    52 return $revision unless $@;
    70 open my $FH, "<", $cache
    71 or die "Unable to open $cache for reading: $!";
    72 chomp($revision = <$FH>);
    73 close $FH or die "Unable to close $cache after reading: $!";
    53 74 }
    54
    55 $revision = _analyze_sandbox();
    56
    57 if (! -f $cache) {
    58 eval {
    59 open my $FH, ">", $cache;
    60 print $FH "$revision\n";
    61 close $FH;
    62 };
    75 else {
    76 $revision = _analyze_sandbox();
    77 _print_to_cache($cache, $revision);
    63 78 }
    64 79 return $revision;
    65 80 }

  • trunk/MANIFEST

     
    1 1 # ex: set ro:
    2 2 # $Id$
    3 3 #
    4 # generated by tools/dev/mk_manifest_and_skip.pl Sun Jul 20 10:24:04 2008 UT
    4 # generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 22 00:54:15 2008 UT
    5 5 #
    6 6 # See tools/dev/install_files.pl for documentation on the
    7 7 # format of this file.
    … …  
    3340 3340 t/configure/058-fatal_step.t []
    3341 3341 t/configure/059-silent.t []
    3342 3342 t/configure/060-silent.t []
    3343 t/configure/061-revision_from_cache.t []
    3343 3344 t/configure/testlib/Make_VERSION_File.pm []
    3344 3345 t/configure/testlib/Tie/Filehandle/Preempt/Stdin.pm []
    3345 3346 t/configure/testlib/init/alpha.pm []

  • trunk/t/configure/017-revision_from_cache.t

     
    20 20 my $cwd = cwd();
    21 21 {
    22 22 my $rev = 16000;
    23 my ($cache, $libdir) = setup_cache($rev, $cwd);
    24 require Parrot::Revision;
    25 no warnings 'once';
    26 is($Parrot::Revision::current, $rev,
    27 "Got expected revision number from cache");
    28 use warnings;
    29 unlink qq{$libdir/Parrot/Revision.pm}
    30 or croak "Unable to delete file after testing";
    31 ok( chdir $cwd, "Able to change back to starting directory");
    32 }
    33
    34 pass("Completed all tests in $0");
    35
    36 ##### SUBROUTINES #####
    37
    38 sub setup_cache {
    39 my ($rev, $cwd) = @_;
    23 40 my $tdir = tempdir( CLEANUP => 1 );
    24 41 ok( chdir $tdir, "Changed to temporary directory for testing" );
    25 42 my $libdir = qq{$tdir/lib};
    … …  
    34 51 or croak "Unable to open $cache for writing";
    35 52 print $FH qq{$rev\n};
    36 53 close $FH or croak "Unable to close $cache after writing";
    37 require Parrot::Revision;
    38 no warnings 'once';
    39 is($Parrot::Revision::current, $rev,
    40 "Got expected revision number from cache");
    41 use warnings;
    42 unlink qq{$libdir/Parrot/Revision.pm}
    43 or croak "Unable to delete file after testing";
    44 ok( chdir $cwd, "Able to change back to starting directory");
    54 return ($cache, $libdir);
    45 55 }
    46 56
    47 pass("Completed all tests in $0");
    48
    49 57 ################### DOCUMENTATION ###################
    50 58
    51 59 =head1 NAME

  • trunk/t/configure/061-revision_from_cache.t

     
    1 #! perl
    2 # Copyright (C) 2007, The Perl Foundation.
    3 # $Id$
    4 # 061-revision_from_cache.t
    5
    6 use strict;
    7 use warnings;
    8
    9 use Test::More;
    10 plan( skip_all => "\nRelevant only when working in checkout from repository and during configuration" )
    11 unless (-e 'DEVELOPING' and ! -e 'Makefile');
    12 plan( tests => 25 );
    13 use Carp;
    14 use Cwd;
    15 use File::Copy;
    16 use File::Path ();
    17 use File::Temp qw| tempdir |;
    18 use lib qw( lib );
    19 use Parrot::Revision ();
    20
    21 my $cwd = cwd();
    22 { # revision undef
    23 my $rev = 16000;
    24 my ($cache, $libdir) = setup_cache($rev, $cwd);
    25 my $prev = 34567;
    26 my $revision = undef;
    27 my $current = 12345;
    28 my $ret = Parrot::Revision::_handle_update( {
    29 prev => $prev,
    30 revision => $revision,
    31 cache => $cache,
    32 current => $current,
    33 } );
    34 is($ret, q{unknown}, "Got expected return value from _handle_update");
    35 unlink qq{$libdir/Parrot/Revision.pm}
    36 or croak "Unable to delete file after testing";
    37 ok( chdir $cwd, "Able to change back to starting directory");
    38 }
    39
    40 { # prev undef
    41 my $rev = 16000;
    42 my ($cache, $libdir) = setup_cache($rev, $cwd);
    43 my $revision = 67890;
    44 my $current = 12345;
    45 my $ret = Parrot::Revision::_handle_update( {
    46 prev => undef,
    47 revision => $revision,
    48 cache => $cache,
    49 current => $current,
    50 } );
    51 is($ret, $current, "Got expected return value from _handle_update");
    52 unlink qq{$libdir/Parrot/Revision.pm}
    53 or croak "Unable to delete file after testing";
    54 ok( chdir $cwd, "Able to change back to starting directory");
    55 }
    56
    57 { # prev and revision both defined and identical
    58 my $rev = 16000;
    59 my ($cache, $libdir) = setup_cache($rev, $cwd);
    60 my $prev = 67890;
    61 my $revision = 67890;
    62 my $current = 12345;
    63 my $ret = Parrot::Revision::_handle_update( {
    64 prev => $prev,
    65 revision => $revision,
    66 cache => $cache,
    67 current => $current,
    68 } );
    69 is($ret, $current, "Got expected return value from _handle_update");
    70 unlink qq{$libdir/Parrot/Revision.pm}
    71 or croak "Unable to delete file after testing";
    72 ok( chdir $cwd, "Able to change back to starting directory");
    73 }
    74
    75 { # prev and revision both defined but not identical
    76 my $rev = 16000;
    77 my ($cache, $libdir) = setup_cache($rev, $cwd);
    78 my $prev = 67890;
    79 my $revision = 67891;
    80 my $current = 12345;
    81 my $ret = Parrot::Revision::_handle_update( {
    82 prev => $prev,
    83 revision => $revision,
    84 cache => $cache,
    85 current => $current,
    86 } );
    87 is($ret, $revision, "Got expected return value from _handle_update");
    88 unlink qq{$libdir/Parrot/Revision.pm}
    89 or croak "Unable to delete file after testing";
    90 ok( chdir $cwd, "Able to change back to starting directory");
    91 }
    92
    93 pass("Completed all tests in $0");
    94
    95
    96 ##### SUBROUTINES #####
    97
    98 sub setup_cache {
    99 my ($rev, $cwd) = @_;
    100 my $tdir = tempdir( CLEANUP => 1 );
    101 ok( chdir $tdir, "Changed to temporary directory for testing" );
    102 my $libdir = qq{$tdir/lib};
    103 ok( (File::Path::mkpath( $libdir )), "Able to make libdir");
    104 local @INC;
    105 unshift @INC, $libdir;
    106 ok( (File::Path::mkpath( qq{$libdir/Parrot} )), "Able to make Parrot dir");
    107 ok( (copy qq{$cwd/lib/Parrot/Revision.pm},
    108 qq{$libdir/Parrot}), "Able to copy Parrot::Revision");
    109 my $cache = q{.parrot_current_rev};
    110 open my $FH, ">", $cache
    111 or croak "Unable to open $cache for writing";
    112 print $FH qq{$rev\n};
    113 close $FH or croak "Unable to close $cache after writing";
    114 return ($cache, $libdir);
    115 }
    116
    117 ################### DOCUMENTATION ###################
    118
    119 =head1 NAME
    120
    121 061-revision_from_cache.t - test Parrot::Revision
    122
    123 =head1 SYNOPSIS
    124
    125 % prove t/configure/061-revision_from_cache.t
    126
    127 =head1 DESCRIPTION
    128
    129 The files in this directory test functionality used by F<Configure.pl>.
    130
    131 The tests in this file test Parrot::Revision (F<lib/Parrot/Revision.pm>).
    132
    133 =head1 AUTHOR
    134
    135 James E Keenan
    136
    137 =head1 SEE ALSO
    138
    139 Parrot::Configure, F<Configure.pl>.
    140
    141 =cut
    142
    143 # Local Variables:
    144 # mode: cperl
    145 # cperl-indent-level: 4
    146 # fill-column: 100
    147 # End:
    148 # vim: expandtab shiftwidth=4: