package VCP::TestUtils ; =head1 NAME VCP::TestUtils - support routines for VCP testing =cut use Exporter ; @EXPORT = qw( assert_eq slurp mk_tmp_dir perl_cmd vcp_cmd p4d_borken p4_options launch_p4d cvs_options init_cvs s_content rm_elts ) ; @ISA = qw( Exporter ) ; use strict ; use Carp ; use Cwd ; use File::Path ; use File::Spec ; use IPC::Run qw( run ) ; use POSIX ':sys_wait_h' ; =head1 General utility functions =over =item mk_tmp_dir Creates one or more temporary directories, which will be removed upon exit in an END block =cut { my @tmp_dirs ; END { rmtree \@tmp_dirs } sub mk_tmp_dir { rmtree \@_ ; mkpath \@_, 0, 0770 ; push @tmp_dirs, @_ ; } } =item assert_eq assert_eq $test_name, $in, $out ; dies with a useful diff in $@ is $in ne $out. Returns nothing. Requires a diff that knows about the -d and -U options. =cut sub assert_eq { my ( $name, $in, $out ) = @_ ; if ( $in ne $out ) { open F, ">$name.in" ; print F $in ; close F ; open F, ">$name.out" ; print F $out ; close F ; my @cmd = ( 'diff', '-U', '10', "$name.in", "$name.out" ) ; my $diff ; if ( run( \@cmd, \undef, \$diff ) && $? != 256 ) { $diff = "`" . join( " ", @cmd ) . "` returned $?" ; } die $diff ; } } =item slurp $guts = slurp $filename ; =cut sub slurp { my ( $fn ) = @_ ; open F, "<$fn" or die "$!: $fn" ; local $/ ; return <F> ; } =item perl_cmd @perl = perl_cmd Returns a list containing the Perl executable and some options to reproduce the current Perl options , like -I. =cut sub perl_cmd { my %seen ; return ( $^X, ( map { my $s = $_ ; $s = File::Spec->rel2abs( $_ ) ; "-I$s" ; } grep ! $seen{$_}++, @INC ) ) ; } =item vcp_cmd @vcp = vcp_cmd Returns a list containing the Perl executable and some options to reproduce the current Perl options , like -I. =cut sub vcp_cmd { ## 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 -x "bin/$vcp" ; $vcp = "../bin/$vcp" if -x "../bin/$vcp" ; $vcp = File::Spec->rel2abs( $vcp ) ; return ( perl_cmd, $vcp ) ; } =back =head1 XML "cleanup" functions These are used to get rid of content or elements that are known to differ when comparing the revml fed in to a repository with the revml that comes out. =over =item s_content s_content $elt_type1, $elt_type2, ..., \$string1, \$string2, ..., $new_content ; Changes the contents of the elements, since some things, like suer id or mod_time can't be the same after going through a repository. If $new_val is not supplied, a constant string is used. =cut sub s_content { my $new_val = pop if @_ && ! ref $_[-1] ; $new_val = "<!-- deleted by test suite -->" unless defined $new_val ; my $elt_type_re = do { my @a ; push @a, quotemeta shift while @_ && ! ref $_[0] ; join "|", @a ; } ; $$_ =~ s{(<($elt_type_re)[^>]*?>).*?(</\2\s*>)} {$1$new_val$3}sg for @_ ; $$_ =~ s{(<($elt_type_re)[^>]*?>).*?(</\2\s*>)}{$1$new_val$3}sg for @_ ; } =item rm_elts rm_elts $elt_type1, $elt_type2, ..., \$string1, \$string2 rm_elts $elt_type1, $elt_type2, ..., qr/$content_re/, \$string1, \$string2 Removes the specified elements from the strings, including leading whitespace and trailing line separators. If the optional $content_re regular expression is provided, then only elements containing that pattern will be removed. =cut sub rm_elts { my $elt_type_re = do { my @a ; push @a, quotemeta shift while @_ && ! ref $_[0] ; join "|", @a ; } ; my $content_re = @_ && ref $_[0] eq "Regexp" ? shift : qr/.*?/s ; my $re = qr{^\s*<($elt_type_re)[^>]*?>$content_re</\1\s*>\r?\n}sm ; $$_ =~ s{$re}{}g for @_ ; } =head1 p4 repository mgmt functions =over =item p4_options $p4_options = p4_options $prefix ; Returns a hash of options. $prefix should be unique to the calling program. =cut sub p4_options { my $prefix = shift || "" ; my $tmp = File::Spec->tmpdir ; return { repo => File::Spec->catdir( $tmp, "${prefix}p4repo" ), # work => File::Spec->catdir( $tmp, "${prefix}p4work" ), user => "${prefix}t_user", port => 19666, } ; } =item p4_borken Returns true if the p4 is missing or too old (< 99.2). =cut sub p4d_borken { my $p4dV = `p4d -V` || 0 ; return "p4d not found" unless $p4dV ; my ( $p4d_version ) = $p4dV =~ m{^Rev[^/]*/[^/]*/([^/]*)}m ; my $min_version = 99.2 ; return "p4d version too old, need at least $min_version" unless $p4d_version >= $min_version ; return "" ; } =item launch_p4d launch_p4d $p4_options ; Creates an empty repository and launches a p4d for it. The p4d will be killed and it's repository deleted on exit. =cut sub launch_p4d { my $options = pop ; croak "No options passed" unless $options && %$options ; { my $borken = p4d_borken ; croak $borken if $borken ; } mk_tmp_dir $options->{repo} ; ## Ok, this is wierd: we need to fork & run p4d in foreground mode so that ## we can capture it's PID and kill it later. There doesn't seem to be ## the equivalent of a 'p4d.pid' file. If we let it daemonize, then I ## don't know how to get it's PID. my $p4d_pid = fork ; unless ( $p4d_pid ) { ## Ok, there's a tiny chance that this will fail due to a port ## collision. Oh, well. exec 'p4d', '-f', '-r', $options->{repo}, '-p', $options->{port} ; die "$!: p4d" ; } sleep 1 ; ## Wait for p4d to start. 'twould be better to wait for P4PORT to ## be seen. select( undef, undef, undef, 0.250 ) ; END { return unless defined $p4d_pid ; kill 'INT', $p4d_pid or die "$! $p4d_pid" ; my $t0 = time ; my $dead_child ; while ( $t0 + 15 > time ) { select undef, undef, undef, 0.250 ; $dead_child = waitpid $p4d_pid, WNOHANG ; warn "$!: $p4d_pid" if $dead_child == -1 ; last if $dead_child ; } unless ( defined $dead_child && $dead_child > 0 ) { print "terminating $p4d_pid\n" ; kill 'TERM', $p4d_pid or die "$! $p4d_pid" ; $t0 = time ; while ( $t0 + 15 > time ) { select undef, undef, undef, 0.250 ; $dead_child = waitpid $p4d_pid, WNOHANG ; warn "$!: $p4d_pid" if $dead_child == -1 ; last if $dead_child ; } } unless ( defined $dead_child && $dead_child > 0 ) { print "killing $p4d_pid\n" ; kill 'KILL', $p4d_pid or die "$! $p4d_pid" ; } } } =back =head1 CVS mgmt functions =over =item cvs_options $cvs_options = cvs_options $prefix ; returns the options needed to build and access a cvs repository. =cut sub cvs_options { my $prefix = shift || "" ; my $tmp = File::Spec->tmpdir ; return { repo => File::Spec->catdir( $tmp, "${prefix}cvsroot" ), work => File::Spec->catdir( $tmp, "${prefix}cvswork" ), } ; } =item init_cvs init_cvs $cvs_options, $module_name ; Creates a CVS repository containing an empty module. =cut sub init_cvs { my ( $options, $module ) = @_ ; my ( $repo_dir, $work_dir ) = @{$options}{ 'repo', 'work' } ; my $cwd = cwd ; ## Give vcp ... cvs:... a repository to work with. Note that it does not ## use $cvswork, just this test script does. $ENV{CVSROOT} = $options->{repo} ; mk_tmp_dir $options->{repo} ; run [ qw( cvs init ) ] or die "cvs init failed" ; chdir $work_dir or die "$!: $work_dir" ; mkdir $module, 0770 or die "$!: $module" ; chdir $module or die "$!: $module" ; run [ qw( cvs import -m ), "$module import", $module, "${module}_vendor", "${module}_release" ] or die "cvs import failed" ; chdir $cwd or die "$!: $cwd" ; delete $ENV{CVSROOT} ; # chdir ".." or die "$! .." ; # # system qw( cvs checkout CVSROOT/modules ) and die "cvs checkout failed" ; # # open MODULES, ">>CVSROOT/modules" or die "$!: CVSROOT/modules" ; # print MODULES "\n$module $module/\n" or die "$!: CVSROOT/modules" ; # close MODULES or die "$!: CVSROOT/modules" ; # # system qw( cvs commit -m foo CVSROOT/modules ) # and die "cvs commit failed" ; } =head1 COPYRIGHT Copyright 2000, Perforce Software, Inc. All Rights Reserved. This module and the VCP package are licensed according to the terms given in the file LICENSE accompanying this distribution, a copy of which is included in L<vcp>. =cut 1 ;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#68 | 5403 | Barrie Slaymaker | - Misc logging, maintainability & debugging improvements | ||
#67 | 5083 | Barrie Slaymaker | - Minor rmtree() nag about no root dirs prevented | ||
#66 | 4476 | Barrie Slaymaker | - misc bugfixes | ||
#65 | 4417 | Barrie Slaymaker |
- Adapt to "estimated values" messages - Adapt to more accurate test suite |
||
#64 | 4405 | Barrie Slaymaker | - test suites suppress banner to prevent false error detection in testnig stdout | ||
#63 | 4143 | Barrie Slaymaker | - Further adaptation to vcp.exe packaging format | ||
#62 | 3974 | Barrie Slaymaker | - IPC::Run no longer required | ||
#61 | 3970 | Barrie Slaymaker |
- VCP::Source handles rev queing, uses disk to reduce RAM - Lots of other fixes |
||
#60 | 3826 | Barrie Slaymaker |
- test suite: the .expected and .got files may be copy-n-pasted from console output to a diff or gvim -d command on Win32. |
||
#59 | 3738 | Barrie Slaymaker | - TestUtils::rm_elts() can now delete "<foo />" tags | ||
#58 | 3716 | Barrie Slaymaker | - .got and .expected files are now left in /tmp on test failure | ||
#57 | 3713 | Barrie Slaymaker |
- tests now usually emit large diffs to log file - tests now emit .got and .expected files when things differ |
||
#56 | 3692 | Barrie Slaymaker | - assert_eq() is deprecated | ||
#55 | 3560 | John Fetkovich |
make text UI ready for testing via piping from stdin. VCP::TestUtils::Run now optionally may use IPC::Run rather than IPC::Run3. |
||
#54 | 3510 | Barrie Slaymaker | - VSS --continue and branching support | ||
#53 | 3497 | Barrie Slaymaker | - Get more context from eq_or_diff() | ||
#52 | 3460 | Barrie Slaymaker |
- Revamp Plugin/Source/Dest hierarchy to allow for reguritating options in to .vcp files |
||
#51 | 3452 | Barrie Slaymaker | - Show more context in test failure diffs | ||
#50 | 3421 | Barrie Slaymaker |
- Fix regex quoting bugs in copy_dir_tree() - Code cleanup - Better docs - add eq_or_diff() (will move out of lots of test scripts) - vss_borken() now looks for runable MKSS.EXE instead of seeing if $ENV{SSUSER} is set |
||
#49 | 3115 | Barrie Slaymaker |
Move sorting function to the new VCP::Filter::sort; it's for testing and reporting only and the code was bloating VCP::Dest and limiting VCP::Rev and VCP::Dest optimizations. Breaks test suite in minor way. |
||
#48 | 2978 | Barrie Slaymaker | Fix head revs reporting routine to cope with <> branch_id. | ||
#47 | 2974 | John Fetkovich |
fix parse_files_and_revids_from_revml to deal with branches and multiple dotted revs |
||
#46 | 2969 | John Fetkovich | added tweak to force test to pass | ||
#45 | 2968 | John Fetkovich |
altered tests to use parse_files_and_revids_from_head_revs_db change to that routine too. |
||
#44 | 2959 | John Fetkovich |
added dump method to lib/VCP/DB_File/sdbm.pm to dump keys => values from a sdbm file. removed similar code from bin/dump_head_revs, bin/dump_rev_map and bin/dump_main_branch_id and called this method instead. also made parse_files_and_revids_from_head_revs_db sub in TestUtils to use in test suites instead of parse_files_and_revids_from_p4_files et. al. |
||
#43 | 2951 | John Fetkovich | renamed run_new to run, mothballed the old run sub. | ||
#42 | 2939 | John Fetkovich | added empty() call | ||
#41 | 2926 | John Fetkovich |
remove --state-location switch add --db-dir and --repo-id switches build state location from concatenation of those two. |
||
#40 | 2916 | John Fetkovich | fix 'parse_files_and_revids_*' sub names in docs and usages. | ||
#39 | 2836 | John Fetkovich |
Make Source::p4 use --continue and --bootstrap options (partial) update test suite appropriately |
||
#38 | 2801 | Barrie Slaymaker | Add rm_dir_tree. | ||
#37 | 2784 | Barrie Slaymaker |
Restore logging of what command is being run so that testers can see what blew up. |
||
#36 | 2767 | John Fetkovich | comment fix | ||
#35 | 2766 | John Fetkovich | removed an already done TODO comment | ||
#34 | 2754 | John Fetkovich | Convert to use IPC::Run3::run3 rather than IPC::Run::run | ||
#33 | 2714 | Barrie Slaymaker |
Simplify t/90*cvs.t tests, remove make_cvsroots for speed and simplicity. |
||
#32 | 2709 | Barrie Slaymaker | allow ok_result_codes to be passed to TestUtils::run() | ||
#31 | 2663 | Barrie Slaymaker |
Fix mtime bug in VCP::Dest::cvs in branching code Improve temp directory management |
||
#30 | 2645 | John Fetkovich | formatting change | ||
#29 | 2622 | John Fetkovich |
Split revml2cvs.t into three files, then improved; particularly made changes to use parse_files_and_revids_from_revml (already in TestUtils.pm) and parse_files_and_revids_from_cvs_history (newly added to TestUtils.pm) to do checks on changes. |
||
#28 | 2621 | John Fetkovich |
Changed parse_files_and_revids_from_revml to allow optionally ignoring revs containing a <delete /> tag. |
||
#27 | 2619 | John Fetkovich | Fixes to parse_files_and_revids_from_revml | ||
#26 | 2599 | John Fetkovich |
Changed parse_files_and_revids_from_p4_files to accept file_spec argument to p4 files command. Modified test suites to use it. Various documentation changes to TestUtils.pm. |
||
#25 | 2591 | John Fetkovich |
Changed 90revml2p4_1.t to use improvements previously done to 90revml2p4_0.t. Factored out parse_files_and_revids_from_p4_files common to both into TestUtils.pm. |
||
#24 | 2590 | John Fetkovich | Cleared up some documentation. | ||
#23 | 2589 | John Fetkovich |
Split 90p4.t into 90revml2p4_0.t, 90revml2p4_1.t, 91p42revml.t, 95p42cvs.t. Added some utilities to the library files listed. |
||
#22 | 2445 | John Fetkovich |
added compile_dtd_cmd, and factored out find_command from compile_dtd_cmd and vcp_cmd. |
||
#21 | 2293 | Barrie Slaymaker | Update CHANGES, TODO, improve .vcp files, add --init-cvs | ||
#20 | 2267 | Barrie Slaymaker | factor out cvs2revml, test both --use-cvs and direct modes, with times | ||
#19 | 2265 | Barrie Slaymaker | factor out t/95cvs2p4.pm and allow it to reuse the cvs repo for speed. | ||
#18 | 1998 | Barrie Slaymaker | Initial, revml and core VCP support for branches | ||
#17 | 1855 | Barrie Slaymaker |
Major VSS checkin. Works on Win32 |
||
#16 | 1809 | Barrie Slaymaker | VCP::Patch should ignore lineends | ||
#15 | 1731 | Barrie Slaymaker |
Don't leave $? set in END{} block when killing p4d |
||
#14 | 1728 | Barrie Slaymaker | CVS on win32, minor bugfixes | ||
#13 | 1358 | Barrie Slaymaker | Win32 changes | ||
#12 | 1069 | Barrie Slaymaker | bump to 0.25, hide spurious test output | ||
#11 | 1055 | Barrie Slaymaker |
add sorting, revamp test suite, misc cleanup. Dest/revml is not portable off my system yet (need to release ...::Diff) |
||
#10 | 1022 | Barrie Slaymaker |
Perl "$foo\_..." => "${foo}_..." cleanup by Peter Prymmer <PPrymmer@factset.com>. |
||
#9 | 719 | Barrie Slaymaker | vcp 0.221 | ||
#8 | 701 | Barrie Slaymaker | Fixed VCP::Dest::p4 re-rooting problem, further t/* cleanup | ||
#7 | 699 | Barrie Slaymaker | test suite cleanup | ||
#6 | 696 | Barrie Slaymaker | cleanup. | ||
#5 | 692 | Barrie Slaymaker |
Add VCP::Utils::p4 and use it to get VCP::Dest::p4 to create it's own client view as needed. |
||
#4 | 628 | Barrie Slaymaker | Cleaned up POD in bin/vcp, added BSD-style license. | ||
#3 | 615 | Barrie Slaymaker |
Detect p4d <= 99.2 and skip tests. Fix a use strict problem. Both reported by Nick Ing-Simmons. |
||
#2 | 614 | Barrie Slaymaker |
avoid 'make test' die-ing with a use-strict warning, patch from Nick Ing-Simmons <nick@ing-simmons.net>, <20010522191857.623.23@dromedary.ni-s.u-net.com> |
||
#1 | 611 | Barrie Slaymaker | Shoulda added this this moring. |