1use Test2::V0 -target => 'App::Yath::Util';
2use Test2::Tools::Spec;
3
4use Test2::Util qw/CAN_REALLY_FORK/;
5use Test2::Tools::GenTemp qw/gen_temp/;
6use Test2::Harness::Util qw/clean_path/;
7use File::Temp qw/tempfile/;
8use Cwd qw/cwd/;
9
10use File::Spec;
11
12use App::Yath::Util qw{
13    find_pfile
14    is_generated_test_pl
15    fit_to_width
16    isolate_stdout
17    find_yath
18    find_in_updir
19};
20
21imported_ok qw{
22    find_pfile
23    is_generated_test_pl
24    fit_to_width
25    isolate_stdout
26    find_yath
27    find_in_updir
28};
29
30my $initial_dir = cwd();
31after_each chdir => sub {
32    chdir($initial_dir);
33};
34
35tests find_yath => sub {
36    local $App::Yath::Script::SCRIPT = 'foobar';
37    is(find_yath, 'foobar', "Use \$App::Yath::Script::SCRIPT if set");
38
39    $App::Yath::Script::SCRIPT = undef;
40
41    my $tmp = gen_temp('scripts' => {'yath' => 'xxx'});
42    my $yath = clean_path(File::Spec->catfile($tmp, 'scripts', 'yath'));
43    chdir($tmp);
44    eval { chmod(0755, File::Spec->catfile($tmp, 'scripts', 'yath')); 1 } or warn $@;
45    is(find_yath, $yath, "found yath script in scripts/ dir");
46    is($App::Yath::Script::SCRIPT, $yath, "cached result");
47
48    my $tmp2 = gen_temp();
49    chdir($tmp2);
50
51    $App::Yath::Script::SCRIPT = undef;
52    local *App::Yath::Util::Config = {};
53    like(
54        dies { find_yath },
55        qr/Could not find yath in Config paths/,
56        "No yath found"
57    );
58
59    local *App::Yath::Util::Config = {
60        scriptdir => File::Spec->catdir($tmp, 'scripts'),
61    };
62    like(find_yath, qr{\Q$yath\E$}, "Found it in a config path");
63};
64
65tests isolate_stdout => sub {
66    my ($stdout_r, $stdout_w, $stderr_r, $stderr_w);
67    pipe($stdout_r, $stdout_w) or die "Could not open pipe: $!";
68    pipe($stderr_r, $stderr_w) or die "Could not open pipe: $!";
69
70    my $pid = fork;
71    die "Could not fork" unless defined $pid;
72
73    unless ($pid) { # child
74        close($stdout_r);
75        close($stderr_r);
76        open(STDOUT, '>&', $stdout_w) or die "Could not redirect STDOUT";
77        open(STDERR, '>&', $stderr_w) or die "Could not redirect STDOUT";
78        my $fh = isolate_stdout();
79
80        print $fh "Should go to STDOUT\n";
81        print "Should go to STDERR 1\n";
82        print STDOUT "Should go to STDERR 2\n";
83        print STDERR "Should go to STDERR 3\n";
84
85        exit 0;
86    }
87
88    close($stdout_w);
89    close($stderr_w);
90    waitpid($pid, 0);
91    is($?, 0, "Clean exit");
92
93    is(
94        [<$stdout_r>],
95        ["Should go to STDOUT\n"],
96        "Got expected STDOUT"
97    );
98    is(
99        [<$stderr_r>],
100        [
101            "Should go to STDERR 1\n",
102            "Should go to STDERR 2\n",
103            "Should go to STDERR 3\n",
104        ],
105        "Got expected STDERR"
106    );
107} if CAN_REALLY_FORK;
108
109subtest is_generated_test_pl => sub {
110    ok(!is_generated_test_pl(__FILE__), "This is not a generated test file");
111
112    my ($fh, $name) = tempfile(UNLINK => 1);
113    print $fh "use strict;\nuse warnings;\n# THIS IS A GENERATED YATH RUNNER TEST\ndfasdafas\n";
114    close($fh);
115    ok(is_generated_test_pl($name), "Found a generated file");
116};
117
118subtest find_in_updir => sub {
119    my $tmp = gen_temp(
120        thefile => 'xxx',
121        nest => {
122            nest_a => { thefile => 'xxx' },
123            nest_b => {},
124        },
125    );
126
127    chdir(File::Spec->catdir($tmp, 'nest', 'nest_a')) or die "$!";
128    my $file = File::Spec->catfile($tmp, 'nest', 'nest_a', 'thefile');
129    like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot");
130
131    chdir(File::Spec->catdir($tmp, 'nest', 'nest_b')) or die "$!";
132    $file = File::Spec->catfile($tmp, 'thefile');
133    like(find_in_updir('thefile'), qr{\Q$file\E$}, "Found file in expected spot");
134};
135
136subtest fit_to_width => sub {
137    is(fit_to_width(100, " ", "hello there"), "hello there", "No change for short string");
138    is(fit_to_width(2, " ", "hello there"), "hello\nthere", "Split across multiple lines");
139
140    is(
141        fit_to_width(20, " ", "hello there, this is a longer string that needs splitting."),
142        "hello there, this is\na longer string that\nneeds splitting.",
143        "Split across multiple lines"
144    );
145
146    is(
147        fit_to_width(100, " ", ["hello there", "this is a", "longer string that", "needs no splitting."]),
148        "hello there this is a longer string that needs no splitting.",
149        "Split across multiple lines"
150    );
151
152    is(
153        fit_to_width(50, " ", ["hello there", "this is a", "longer string that", "needs splitting."]),
154        "hello there this is a longer string that\nneeds splitting.",
155        "Split across multiple lines"
156    );
157};
158
159done_testing;
160