1package run_tests; 2 3use strict; 4use warnings; 5 6use mix_tests qw(combine_nk); 7use Test::More; 8use IPC::Cmd (); 9use File::Spec (); 10use File::Temp (); 11use File::Basename; 12 13use Data::Dumper; 14use Config; 15 16sub new { 17 my ($class, $exename) = @_; 18 my %instance = ( 19 exename => $exename, 20 ); 21 my $self = bless( \%instance, $class ); 22 return $self; 23} 24 25sub get_test_functions { 26 my ($self) = @_; 27 defined($self->{test_functions}) and return $self->{test_functions}; 28 my $exename = basename($self->{exename}); 29 # prepare logging to temporary file only during tests running 30 my ($logfh, $logfn) = File::Temp::tempfile( TMPDIR => 1, UNLINK => 1, 31 SUFFIX => ".log", TEMPLATE => "$exename-XXXXXXXX" ); 32 close($logfh); 33 my ($propfh, $propfn) = File::Temp::tempfile( TMPDIR => 1, UNLINK => 1, 34 SUFFIX => ".properties", TEMPLATE => "SG_TEST_XXXXXXX" ); 35 print $propfh <<EOP; 36log4cplus.logger.statgrab=TRACE, LOGFILE 37 38log4cplus.appender.LOGFILE=log4cplus::FileAppender 39log4cplus.appender.LOGFILE.File=$logfn 40log4cplus.appender.LOGFILE.layout=log4cplus::TTCCLayout 41EOP 42 $propfh->flush(); 43 44 $ENV{SGTEST_LOG_PROPERTIES} = $propfn; 45 my $fh; 46 47 open( $fh, "-|", "$self->{exename} -l" ) or die "Can't read from pipe: $!"; 48 my @funcs = <$fh>; 49 close( $fh ) or die "Can't close pipe: $!"; 50 chomp @funcs; 51 52 $self->{test_functions} = \@funcs; 53 54 return $self->{test_functions}; 55} 56 57sub init_combinations { 58 my ($self) = @_; 59 defined( $self->{combinations} ) and return; 60 61 $self->get_test_functions(); 62 63 $self->{combinations} = []; 64 my $nfuncs = scalar(@{$self->{test_functions}}); 65 66 my @funcs_idx = (0 .. ($nfuncs - 1) ); 67 $self->{combinations}->[0] = []; 68 $self->{combinations}->[$nfuncs] = [ [ @funcs_idx ] ]; 69 $self->{test_function_avail_map} = { map { $_ => $_ } @funcs_idx }; 70 71 return; 72} 73 74sub get_test_combinations { 75 my ($self, $k) = @_; 76 my $inv_k; 77 my $want_inv = 0; 78 79 $k > 0 or $k <= scalar(@{$self->{test_functions}}) or return; 80 81 $self->init_combinations(); 82 defined( $self->{combinations}->[$k] ) and return @{ $self->{combinations}->[$k] }; 83 84 if( $k > ( scalar(@{$self->{test_functions}}) / 2 ) ) { 85 $inv_k = $k; 86 $k = scalar(@{$self->{test_functions}}) - $k; 87 $want_inv = 1; 88 } 89 else { 90 $inv_k = scalar(@{$self->{test_functions}}) - $k; 91 } 92 93 my @combinations = combine_nk( scalar(@{$self->{test_functions}}), $k ); 94 my @inverse_combinations; 95 foreach my $combination (@combinations) { 96 my %remain_func_idx = %{$self->{test_function_avail_map}}; 97 delete @remain_func_idx{@$combination}; 98 my @inverse_combination = sort { $a <=> $b } keys %remain_func_idx; 99 push( @inverse_combinations, \@inverse_combination ); 100 } 101 102 $self->{combinations}->[$k] = \@combinations; 103 $self->{combinations}->[$inv_k] = \@inverse_combinations; 104 105 return $want_inv ? @{ $self->{combinations}->[$inv_k] } : @{ $self->{combinations}->[$k] }; 106} 107 108sub get_all_test_combinations { 109 my ($self) = @_; 110 111 defined( $self->{combinations} ) and return map { @{$_} } @{$self->{combinations}}; 112 113 $self->init_combinations(); 114 115 my $k = int(scalar(@{$self->{test_functions}}) / 2); 116 while( $k > 0 ) { 117 $self->get_test_combinations( $k ); 118 --$k; 119 } 120 121 return map { @{$_} } @{$self->{combinations}}; 122} 123 124sub map_test_variant { 125 my ($self,$variant) = @_; 126 my $tests = join( ",", map { $self->{test_functions}->[$_] } @{$variant} ); 127 return $tests; 128} 129 130sub get_versions { 131 my %versions = ( 132 OS => "$^O ($Config::Config{osvers})", 133 Perl => "$] ($Config::Config{archname})", 134 ); 135 136 for my $mod (qw(IPC::Cmd Test::More)) { 137 $versions{$mod} = $mod->VERSION(); 138 } 139 140 return %versions; 141} 142 143sub run_tests(\@;\@) { 144 my ($self, $args, $variants) = @_; 145 146 ref($variants) eq "ARRAY" or $variants = [ $self->get_all_test_combinations() ]; 147 148 plan( tests => scalar(@{$variants}) ); 149 150 # complain about environment 151 my %versions = get_versions(); 152 my $indent = 20; 153 my @versions = map { sprintf "%s = %s", $_, $versions{$_} } sort keys %versions; 154 diag(join(", ", @versions)); 155 156 # prepare logging to STDOUT only during tests running 157 my ($propfh, $propfn) = File::Temp::tempfile( TMPDIR => 1, UNLINK => 1, 158 SUFFIX => ".properties", TEMPLATE => "SG_TEST_XXXXXXX" ); 159 print $propfh <<EOP; 160log4cplus.logger.statgrab=TRACE, STDOUT 161 162log4cplus.appender.STDOUT=log4cplus::ConsoleAppender 163log4cplus.appender.STDOUT.layout=log4cplus::TTCCLayout 164EOP 165 $propfh->flush(); 166 167 $ENV{SGTEST_LOG_PROPERTIES} = $propfn; 168 169 foreach my $variant (@{$variants}) { 170 ref($variant) eq "ARRAY" or die "Invalid element in variant list"; 171 my $test_variant = $self->map_test_variant($variant); 172 my @exec_args = ($self->{exename}, @$args, '-r', $test_variant); 173 my ($success, $error_message, $full_buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run( 174 command => \@exec_args, verbose => 0, timeout => 60 ); 175 defined $success or $success = 0; 176 my $msg_fn = $success ? Test::More->can("note") : Test::More->can("diag"); 177 &{$msg_fn}('"' . join('" "', @exec_args) . '"'); 178 if( "ARRAY" eq ref($stdout_buf) and 0 != scalar(@{$stdout_buf}) ) { 179 foreach my $line (@{$stdout_buf}) { 180 &{$msg_fn}($line); 181 } 182 } 183 if( "ARRAY" eq ref($stderr_buf) and 0 != scalar(@{$stderr_buf}) ) { 184 foreach my $line (@{$stderr_buf}) { 185 diag($line); 186 } 187 } 188 cmp_ok( $success, '==', 1, $test_variant ); 189 } 190 191 done_testing(); 192} 193 1941; 195