91revml2cvs.t #1

#!/usr/local/bin/perl -w

=head1 NAME

revml2cvs.t - testing of vcp cvs i/o

=cut

use strict ;

use Carp ;
use Cwd ;
use Test ;
use VCP::TestUtils ;

my @vcp = vcp_cmd ;

my $t = -d 't' ? 't/' : '' ;

my $module = 'foo' ;  ## Must match the rev_root in the testrevml files

my $cvs_spec ;

my @revml_out_spec = ( "revml:", "--sort-by=name,rev_id" ) ;

my $max_change_id ;

sub check {
   croak "test failed and FATALTEST set" if $ENV{FATALTEST} && ! $_[0];
}

## I'd like to just diff the RCS files between the one we're
## creating here and some known good ones, but
## I'm woried that different versions of cvs on different systems
## might have slightly different formats.  Note that we can't compare
## to t/cvsroot_[01] because those are created with this tool and that
## would overlook any errors!
##
## We can, however, use direct read, since 90cvs2revml tests that
## against --use-cvs.

my @tests = (
sub {
   my $cvs_options = init_cvsroot "cvs_", $module ;
   $cvs_spec = "cvs:$cvs_options->{repo}:$module/" ;
   $ENV{CVSROOT} = "foobar" ;
   check ok 1 ;
},

##
## Empty import
##
sub {
   run [ @vcp, "revml:-", $cvs_spec ], \"<revml/>" ;
   check ok $?, 0, "`vcp revml:- $cvs_spec` return value"  ;
},

##
## revml->cvs->revml (using direct read) idempotency
##
sub {}, # Two oks in next sub.

sub {
   eval {
      # Reuses repository from last test.
      my $infile  = $t . "test-cvs-in-0.revml" ;
      run [ @vcp, "revml:$infile", $cvs_spec ], \undef;
      check ok 1;
      my $out ;
      run [ @vcp, $cvs_spec, @revml_out_spec ], \undef, \$out;

      my $in = slurp $infile ;

      s_content  qw( rep_desc time user_id          ), \$in, \$out ;
      s_content  qw( rev_root ),                       \$in, $module ;
      rm_elts    qw( mod_time change_id cvs_info    ), \$in        ;
      rm_elts    qw( label ), qr/r_\w+|ch_\w+/,              \$out ;

      $in =~ s{(id="|id>)/ignored}{$1/foo}g;

      assert_eq $infile, $in, $out ;
   } ;
   check ok $@ || '', '', 'diff';
},

##
## Idempotency test for an incremental revml->cvs->revml update
##
sub {},  ## Mult. ok()s in next sub{}.

sub {
   my $infile  = $t . "test-cvs-in-1.revml" ;

   eval {
      ## $in and $out allow us to avoid execing diff most of the time.
      run [ @vcp, "revml:$infile", $cvs_spec ], \undef
	 or die "`vcp revml:$infile $cvs_spec` returned $?" ;

      check ok 1 ;

      my $out ;
      run [ @vcp, $cvs_spec, qw( -r ch_4: ), @revml_out_spec ], \undef, \$out
         or die "`vcp $cvs_spec -r ch_4:` returned $?" ;

      my $in = slurp $infile ;

      s_content  qw( rep_desc time user_id          ), \$in, \$out ;
      s_content  qw( rev_root ),                       \$in, $module ;
      rm_elts    qw( mod_time change_id cvs_info    ), \$in        ;
      rm_elts    qw( label ), qr/r_\w+|ch_\w+/,              \$out ;

      $in =~ s{(id="|id>)/ignored}{$1/foo}g;

      # ch_4 only exists on the main branch (it's ch_4_branch_1 on the
      # side branches).
      $in =~ s{^\s*?<rev id="/foo/branch-0/branched#1\.1\.2\..*?<name>branch-0/branched.*?<rev_id>1\.1\.2\.\d+.*?</rev>\r?\n}{}gsm;
      assert_eq $infile, $in, $out ;
   } ;
   check ok $@ || '', '', 'diff' ;
},

##
## revml->cvs, re-rooting a dir tree
##
## Do this after the above tests so that we don't accidently introduce
## a bunch of additional change
##
sub {}, ## Two ok()'s in next sub.

sub {
   eval {
      ## Hide global $cvs_spec for the nonce
      my $cvs_spec = "$cvs_spec/newdir/..." ;

      my $infile  = $t . "test-cvs-in-0.revml" ;
      ## $in and $out allow us to avoide execing diff most of the time.
      run [ @vcp, "revml:$infile", $cvs_spec ], \undef
	 or die "`vcp revml:$infile $cvs_spec` returned $?" ;

      check ok 1 ;

      my $out ;
      run [ @vcp, $cvs_spec, @revml_out_spec ], \undef, \$out
         or die "`vcp $cvs_spec ", join( " ", @revml_out_spec ), "` returned $?" ;

      my $in = slurp $infile ;

      s_content  qw( rep_desc time user_id                   ), \$in, \$out ;
      rm_elts    qw( mod_time change_id cvs_info             ), \$in, \$out ;
      rm_elts    qw( label ),          qr/r_\w+|ch_\w+/,              \$out ;


      ## Adjust the $in rev_root to look like the result paths.  $in is
      ## now the "expected" output.
      s_content  qw( rev_root ),                       \$in, "foo/newdir" ;

      $in =~ s{(id="|id>)/ignored}{$1/foo/newdir}g;

      assert_eq $infile, $in, $out ;
   } ;
   check ok $@ || '', '', 'diff' ;
},
) ;

plan tests => scalar( @tests ) ;

my $why_skip ;

$why_skip .= cvs_borken ;
$why_skip ? skip( $why_skip, 0 ) : $_->() for @tests ;