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