10vcp.t #8

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

=head1 NAME

vcp.t - testing of vcp command

=cut

use strict ;

use Carp ;
use Test ;
use IPC::Run ;
use VCP::TestUtils ();

my %seen ;
my @perl = ( $^X, map {
      my $s = $_ ;
      $s = File::Spec->rel2abs( $_ ) ;
      "-I$s" ;
   } grep ! $seen{$_}++, @INC
) ;

## We always run vcp by doing a @perl, vcp, to make sure that vcp runs under
## the same version of perl that we are running under.
my $vcp = 'vcp' ;
$vcp = "bin/$vcp"    if -e "bin/$vcp" ;
$vcp = "../bin/$vcp" if -e "../bin/$vcp" ;

$vcp = File::Spec->rel2abs( $vcp ) ;

my @vcp = ( @perl, $vcp ) ;

# Note the spaces instead of tabs and the spaces after the null:
my $transfer = <<'END_TRANSFER';
Source:
        null:   

Destination:    null:  

Map:
    ...#branch                //foo/branch/...             # cvs -> p4
    //...#branch              //foo/branch/...             # same thing

    //blah/blargh/...#branch  //plink/plonk
    //blah/boink/...#branch   //plink/boo
    //...#branch              -                            # cvs -> bitbucket

    //foo/branch/...          //foo/branch/...#branch_id   # p4 -> cvs
    //foo/branch/...          -                            # p4 -> bitbucket
    # hmmm

END_TRANSFER

sub vcp {
   my $exp_results = shift ;
   my $out ;
   my $err ;
   my $pid = IPC::Run::run [ @vcp, @_ ], \undef, \$out, \$err ;
   confess "$vcp ", join( ' ', @_ ), " returned $?\n$out$err"
      if defined $exp_results && ! grep $? == $_ << 8, @$exp_results ;
   return $err . $out ;
}


my @tests = (
#perldoc now complains when run as root, causing this test to fail
#sub { ok vcp( [ 0  ], 'help' ),            qr/OPTIONS/s                       },
sub {
   my $ok = eval {
       VCP::TestUtils::run [ @vcp, "null:", "null:" ];
       1;
   };
   ok $ok || $@, 1, "vcp:-";
},
sub {
   my $ok = eval {
       VCP::TestUtils::run [ @vcp, "vcp:-" ], "<", \$transfer;
       1;
   };
   ok $ok || $@, 1, "vcp:-";
},
sub { ok vcp( [ 2  ], 'foo:' ),             qr/unknown source scheme/s        },
sub { ok vcp( [ 2  ], 'revml:', 'foo:' ),   qr/unknown dest\w* scheme/s       },
sub { ok vcp( [ 1  ], '--foo' ),            qr/foo.*Usage/s                   },

) ;

plan tests => scalar( @tests ) ;

unless ( -e $vcp ) {
   print STDERR "# '$vcp' not found\n" ;
   skip( 1, '' ) for @tests ;
   exit ;
}

$_->() for @tests ;