95cvs2p4.t #1

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

=head1 NAME

cvs.t - testing of vcp cvs i/o

=cut

use strict ;

use Carp ;
use Cwd ;
use File::Spec ;
use IPC::Run qw( run ) ;
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 @revml_out_spec = ( "revml:", "--sort-by=name,rev_id" ) ;

my $max_change_id ;

my $p4_spec_base ;
my $p4d_borken = $ENV{P4DBORKEN} || p4d_borken ;

sub check {
   goto &die if $ENV{FATALTEST} && ! $_[0];
}

my $cvs_root_parent_0 = File::Spec->rel2abs( "$0.d/cvsroot_0/" );
my $infile_0          = $t . "test-cvs-in-0.revml";
my $infile_0_age      = -M $infile_0;
my $cvs_spec_0        = "cvs:$cvs_root_parent_0:$module/" ;

if ( ( -M "$cvs_root_parent_0/CVSROOT" || $infile_0_age ) >= $infile_0_age ) {
   require File::Path;
   warn "Building $cvs_root_parent_0\n";
   File::Path::rmtree [ $cvs_root_parent_0 ] if -e $cvs_root_parent_0;
   File::Path::mkpath [ $cvs_root_parent_0 ], 1;
   init_cvs "cvs_", $module, $cvs_root_parent_0;
   run [ @vcp, "revml:$infile_0", $cvs_spec_0 ], \undef
      or die "`vcp revml:$infile_0 $cvs_spec_0` returned $?" ;
}

my $cvs_root_parent_1 = File::Spec->rel2abs( "$0.d/cvsroot_1/" );
my $infile_1          = $t . "test-cvs-in-1.revml";
my $infile_1_age      = -M $infile_1;
my $cvs_spec_1        = "cvs:$cvs_root_parent_1:$module/" ;

if (  ( -M "$cvs_root_parent_0/CVSROOT" || $infile_0_age ) >= $infile_0_age
   || ( -M "$cvs_root_parent_1/CVSROOT" || $infile_1_age ) >= $infile_1_age
) {
   require File::Path;
   require File::Copy;
   warn "Building $cvs_root_parent_1\n";
   File::Path::rmtree [ $cvs_root_parent_1 ] if -e $cvs_root_parent_1;
   File::Path::mkpath [ $cvs_root_parent_1 ], 1;

   init_cvs "cvs_", $module, $cvs_root_parent_1;
   run [ @vcp, "revml:$infile_0", $cvs_spec_1 ], \undef
      or die "`vcp revml:$infile_0 $cvs_spec_1` returned $?" ;
   run [ @vcp, "revml:$infile_1", $cvs_spec_1 ], \undef
      or die "`vcp revml:$infile_1 $cvs_spec_1` returned $?" ;
}

my @tests = (
sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;

   $ENV{P4USER}   = "foobar_user" ;
   $ENV{P4PORT}   = "foobar_port" ;
   $ENV{P4CLIENT} = "foobar_client" ;
   $ENV{P4PASSWD} = "foobar_passwd" ;

   my $p4_options = launch_p4d "cvs_" ;
   $p4_spec_base = "p4:$p4_options->{user}:\@$p4_options->{port}:" ;
   check ok 1 ;
},

##
## cvs->p4->revml
##
sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;

   my $cvs_spec = $cvs_spec_0;
   my $p4_spec = "$p4_spec_base//depot" ;

   eval {
      run [ @vcp, $cvs_spec, "$p4_spec/..." ], \undef
         or die "`vcp $cvs_spec` returned $?" ;

      my $out ;
      run [ @vcp, "$p4_spec/...", @revml_out_spec ], \undef, \$out ;

      my $infile  = $infile_0;
      my $in = slurp $infile ;

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

      $out =~ s{<rev_id>}{<rev_id>1.}g ;
      $out =~ s{<base_rev_id>}{<base_rev_id>1.}g ;

      $out =~ s{^.*<change_id>(.*?)</change_id>.*(\r\n|\n\r|\n)}{
	 $max_change_id = $1
	    if ! defined $max_change_id || $1 > $max_change_id ;
	 "" ;
      }gem ;

      $in =~ s{(id="|id>)/ignored}{$1//depot}g;
      $out =~ s{((id="|id>)[^>]*)#}{$1#1.}g;

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

sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;
   check ok $max_change_id, 3, "Max change_id in cvs->p4 transfer" ;
},

##
## cvs->p4->revml, re-rooting a dir tree
##
sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;

   ## Hide global $cvs_spec for the nonce
   my $cvs_spec = "$cvs_spec_0/a/deeply/..." ;

   my $p4_spec = "$p4_spec_base//depot/new/..." ;
   eval {
      run [ @vcp, $cvs_spec, $p4_spec ], \undef
         or die "`vcp $cvs_spec $p4_spec` returned $?" ;

      my $out ;
      run [ @vcp, $p4_spec, @revml_out_spec ], \undef, \$out
         or die "`vcp $p4_spec` returned $?" ;

      my $infile  = $t . $infile_0;
      my $in = slurp $infile ;

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


      $out =~ s{<rev_id>}{<rev_id>1.}g ;
      $out =~ s{<base_rev_id>}{<base_rev_id>1.}g ;

      ## Strip out all files from $in that shouldn't be there
      rm_elts    qw( rev ), qr{(?:(?!a/deeply).)*?}s, \$in ;

      ## Adjust the $in paths to look like the result paths.  $in is
      ## now the "expected" output.
      $in =~ s{<name>a/deeply/}{<name>}g ;

      $out =~ s{^.*<change_id>(.*?)</change_id>.*(\r\n|\n\r|\n)}{
	 $max_change_id = $1
	    if ! defined $max_change_id || $1 > $max_change_id ;
	 "" ;
      }gem ;

      $in =~ s{(id="|id>)/ignored/a/deeply}{$1//depot/new}g;
      $out =~ s{((id="|id>)[^>]*)#}{$1#1.}g;

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

sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;
   check ok $max_change_id, 6, "Max change_id in cvs->p4 transfer" ;
},

##
## Incremental cvs->p4->revml update
##
sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;

   my $cvs_spec = $cvs_spec_1;
   my $p4_spec = "$p4_spec_base//depot" ;

   eval {
      run [ @vcp, $cvs_spec, "-r", "ch_4:", "$p4_spec/..." ], \undef
         or die "`vcp $cvs_spec -r ch_4:` returned $?" ;

      my $out ;
      my $first_change = $max_change_id + 1 ;
      run [ @vcp, "$p4_spec/...\@$first_change,#head", @revml_out_spec ],
         \undef, \$out
         or die "`vcp $p4_spec/...\@$first_change,#head` returned $?" ;

      my $infile  = $infile_1;
      my $in = slurp $infile ;

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

      $out =~ s{<rev_id>}{<rev_id>1.}g ;
      $out =~ s{<base_rev_id>}{<base_rev_id>1.}g ;

      $out =~ s{^.*<change_id>(.*?)</change_id>.*(\r\n|\n\r|\n)}{
	 $max_change_id = $1
	    if ! defined $max_change_id || $1 > $max_change_id ;
	 "" ;
      }gem ;

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

sub {
   return skip $p4d_borken, 1, 1, $p4d_borken if $p4d_borken ;
   check ok $max_change_id, 9, "Max change_id in cvs->p4 transfer" ;
},

) ;

plan tests => scalar( @tests ) ;

my $why_skip ;

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