01driver.t #6

  • //
  • guest/
  • perforce_software/
  • revml/
  • t/
  • 01driver.t
  • View
  • Commits
  • Open Download .zip Download (4 KB)
#!/usr/local/bin/perl -w

=head1 NAME

01driver.t - testing of VCP::Driver services

=cut

use strict ;

use Carp ;
use Test ;
use VCP::Utils qw( start_dir_rel2abs );
use VCP::Driver;

my $p ;

sub flatten_spec {
   my ( $obj ) = @_ ;

   return join(
      ' ',
      map(
         {
            local $_ = $obj->$_();
            defined $_ ? $_ : '-' ;
         }
         qw( repo_scheme repo_user repo_password repo_server repo_filespec )
      )
   ) ;
}

my @repo_vectors = (
[ 'scheme:user:password@server:files',
  'scheme user password server files' ],   

[ 'scheme:user:password@ser@:ver:files',
  'scheme user password ser@:ver files' ],   

[ 'scheme:files',
  'scheme - - - files' ],   

[ 'scheme:user@files',
  'scheme - - - user@files' ],   

[ 'scheme:user@:files',
  'scheme user - - files' ],   

) ;

my @tests = (
sub { $p = VCP::Driver->new() ; ok( ref $p, 'VCP::Driver' ) },

sub { ok "axx()" =~ $p->compile_path_re( "a**()" ) },
sub { ok "a/b"   !~ $p->compile_path_re( "a**b"  ) },
sub { ok "a/b"   =~ $p->compile_path_re( "a...b"  ) },
sub { ok "a\\b"  =~ $p->compile_path_re( "a...b"  ) },

##
## rev_root cleanup
##
sub { $p->rev_root( '\\//foo\\//bar\\//' )               ; ok( $p->rev_root, 'foo/bar' )},
sub { $p->deduce_rev_root( '\\foo/bar' )                 ; ok( $p->rev_root, 'foo'     )},
sub { $p->deduce_rev_root( '\\foo/bar/' )                ; ok( $p->rev_root, 'foo/bar' )},
sub { $p->deduce_rev_root( '\\foo/bar/blah*blop/baz' )   ; ok( $p->rev_root, 'foo/bar' )},
sub { $p->deduce_rev_root( '\\foo/bar/blah?blop/baz' )   ; ok( $p->rev_root, 'foo/bar' )},
sub { $p->deduce_rev_root( '\\foo/bar/blah...blop/baz' ) ; ok( $p->rev_root, 'foo/bar' )},

##
## Normalization & de-normalization
##
sub { ok( $p->normalize_name( '/foo/bar/baz' ), 'baz' ) },
#sub { eval {$p->normalize_name( '/foo/hmmm/baz' ) }, ok( $@ ) },
sub { ok( $p->denormalize_name( 'barf' ), 'foo/bar/barf' ) },

( map {
      my ( $spec, $flattened ) = @$_ ;
      my $s;
      sub {
         $p = VCP::Driver->new();  # make sure spec fields initialized
         $p->parse_repo_spec( $spec );
         ok( flatten_spec( $p ), $flattened );
      },
      sub {
         $s = $p->repo_spec_as_string;
         ok $s, $spec;
      },
      sub {
         $p = VCP::Driver->new();  # make sure spec fields initialized
         $p->parse_repo_spec( $s );
         ok( flatten_spec( $p ), $flattened );
      },

   } @repo_vectors
),

sub {
   $p = VCP::Driver->new();  # make sure spec fields initialized
   $p->parse_repo_spec( 'scheme:user:password@server:files' ) ;
   ok( $p->repo_user, 'user' ) ;
},

sub {
   ok( $p->repo_password, 'password' ) ;
},

sub {
   ok( $p->repo_server, 'server' ) ;
},

## Subprocesses that behave as expected
sub {
   $p->run_safely( [ $^X, qw( -e exit(0) ) ] );
   ok $p->command_result_code, 0;
},

sub {
   ok ! eval { $p->run_safely( [ $^X, qw( -e exit(1) ) ] ); 1 };
},

sub {
   ok $p->command_result_code, 1;
},

sub {
   $p->run_safely( [ $^X, qw( -e exit(1) ) ], { ok_result_codes => [ 1 ] } );
   ok $p->command_result_code, 1;
},

sub {
   $p->run_safely( [ $^X, qw( -e exit(1) ) ], { ok_result_codes => [ 0, 1 ] } );
   ok $p->command_result_code, 1;
},

sub {
   ok ! eval { $p->run_safely( [ $^X, qw( -e exit(2) ) ], { ok_result_codes => [ 0, 1 ] } ) };
},

sub {
   ok $p->command_result_code, 2;
},

sub {
   $p->run_safely( [ $^X, qw( -e warn("hi\n") ) ], { stderr_filter => qr/^hi\r?\n/ } );
   ok 1;
},

sub {
   ok join( " ", $p->options_spec ), qr/repo-id.*SCALAR/s;
},

sub {
   ok join( " ", $p->options_as_strings ), qr/#--repo-id/;
},

sub {
   $p->repo_id( "foo" );
   ok join( " ", map "'$_'", $p->options_as_strings ), qr/'--repo-id=foo'/;
},

sub {
   ok $p->revs;
},

sub {
   $p->repo_id( "" );
   ok join( " ", map "'$_'", $p->options_as_strings ), qr/'--repo-id='/;
},

sub {
   @VCP::Source::foo::ISA = qw( VCP::Driver );
   $INC{"VCP/Source/foo.pm"} = start_dir_rel2abs $0; ## To make the POD scanner happy.
   bless $p, "VCP::Source::foo";
   $p->parse_repo_spec( "floo:files" );
   $p->repo_id( "a repo" );
   ok $p->config_file_section_as_string,
      qr/Source:.*floo:files.*repo-id=a repo/s;
},

) ;

plan tests => scalar( @tests ) ;

$_->() for @tests ;
# Change User Description Committed
#6 3970 Barrie Slaymaker - VCP::Source handles rev queing, uses disk to reduce RAM
- Lots of other fixes
#5 3687 Barrie Slaymaker - Destinations may now use compile_path_re()
#4 3532 John Fetkovich changed File::Spec->rel2abs( blah, start_dir )
to      start_dir_rel2abs blah
everywhere.

which
   does the same thing
   and is defined in VCP::Utils
#3 3489 Barrie Slaymaker - Document options emitted to .vcp files.
#2 3464 Barrie Slaymaker - Create VCP::ConfigFileUtils and move bin/vcp::parse_config_file
  in to it.
- Add VCP::ConfigFileUtils::write_config_file()
- Add --output-vcp-file to bin/vcp.
- Add VCP::Driver::repo_spec_as_string()
- Add VCP::Driver::config_file_section_as_string()
- VCP::Driver::parse_repo_spec() now clears any settings that
  are not set by a given spec string (so old values don't
  remain after a call to it).
#1 3460 Barrie Slaymaker - Revamp Plugin/Source/Dest hierarchy to allow for
  reguritating options in to .vcp files