1#: t/Shell.pm 2#: Testing framework for t/sh/*.t 3#: Copyright (C) Yichun "agentzh" Zhang 4 5package t::Shell; 6 7use lib 't/lib'; 8use lib 'inc'; 9use Test::Base -Base; 10use Test::Util; 11use FindBin; 12use Cwd; 13use File::Temp qw( tempdir ); 14#use Data::Dumper::Simple; 15 16our @EXPORT = qw( run_tests run_test ); 17 18filters { 19 cmd => [qw< chomp >], 20 error_code => [qw< eval >], 21}; 22 23our $SHELL; 24 25BEGIN { 26 $SHELL = $ENV{TEST_SHELL_PATH} || "$^X $FindBin::Bin/../../script/sh"; 27 no_diff(); 28} 29 30sub run_test ($) { 31 my $block = shift; 32 #warn Dumper($block->cmd); 33 34 my $tempdir = tempdir( 'backend_XXXXXX', TMPDIR => 1, CLEANUP => 1 ); 35 my $saved_cwd = Cwd::cwd; 36 chdir $tempdir; 37 38 process_pre($block); 39 40 my $cmd = [ split_arg($SHELL), '-c', $block->cmd() ]; 41 if ($^O eq 'MSWin32' and $block->stdout and $block->stdout eq qq{\\"\n}) { 42 workaround($block, $cmd); 43 } else { 44 test_shell_command($block, $cmd); 45 } 46 47 process_found($block); 48 process_not_found($block); 49 process_post($block); 50 51 chdir $saved_cwd; 52} 53 54sub workaround (@) { 55 my ($block, $cmd) = @_; 56 my ($error_code, $stdout, $stderr) = 57 run_shell( $cmd ); 58 #warn Dumper($stdout); 59 my $stdout2 = $block->stdout; 60 my $stderr2 = $block->stderr; 61 my $error_code2 = $block->error_code; 62 63 my $name = $block->name; 64 SKIP: { 65 skip 'Skip the test uncovers quoting issue on Win32', 3 66 if 1; 67 is ($stdout, $stdout2, "stdout - $name"); 68 is ($stderr, $stderr2, "stderr - $name"); 69 is ($error_code, $error_code2, "error_code - $name"); 70 } 71} 72 73sub run_tests () { 74 for my $block (blocks) { 75 run_test($block); 76 } 77} 78 791; 80