1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
#!/usr/bin/perl
#
# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
# SPDX-License-Identifier: BSD-2-Clause
use v5.010;
use strict;
use warnings;
use Test::More;
use Test::Command;
use lib 't/lib';
use Test::FeatureCheck qw(
env_init
get_error_output get_ok_output
test_fcheck_init
);
my %c = env_init;
my @usage_lines;
plan tests => 14;
my $fcheck_base = test_fcheck_init \%c;
# More than one usage line with -h
subtest 'Usage output with -h' => sub {
my $c = Test::Command->new(cmd => [$c{prog}, '-h']);
$c->exit_is_num(0, '-h succeeded');
$c->stderr_is_eq('', '-h did not output any errors');
my @lines = split /\n/, $c->stdout_value;
BAIL_OUT('Too few lines in the -h output') unless @lines > 1;
BAIL_OUT('Unexpected -h first line') unless $lines[0] =~ /^ Usage: .* \s feature[_-]check /x;
@usage_lines = @lines;
};
subtest 'List of its own features' => sub {
my @lines = get_ok_output([$c{prog}, '--features'], 'get features');
is scalar @lines, 1, 'list features output a single line';
BAIL_OUT('No "Features: " on the features line') unless
$lines[0] =~ /^ Features: \s (?<features> .* ) $/x;
my @words = split /\s+/, $+{features};
my %names = map { split /[:\/=]/, $_, 2 } @words;
BAIL_OUT('No "feature-check" in the features list') unless
defined $names{'feature-check'};
BAIL_OUT('No "single" in the features list') unless
defined $names{'single'};
BAIL_OUT('Only know how to test the "single" feature version 1.x') unless
$names{'single'} =~ m{^ 1 (?: \..* )? $ }x;
BAIL_OUT('Found "x" in the features list') if
defined $names{x};
};
subtest 'Fail with no program or feature specified' => sub {
my @lines = get_error_output([$c{prog}], 'no program specified');
if ($c{is_python}) {
ok join('\n', @lines) =~ m{^Usage:},
'no program output the usage message';
} else {
isnt index(join("\n", @lines), join("\n", @usage_lines)), -1,
'no program output the usage message';
}
};
subtest 'Fail with no feature specified' => sub {
my @lines = get_error_output([$c{prog}, $c{fcheck}],
'no feature specified');
if ($c{is_python}) {
ok join('\n', @lines) =~ m{^Usage:},
'no feature output the usage message';
} else {
isnt index(join("\n", @lines), join("\n", @usage_lines)), -1,
'no feature output the usage message';
}
};
subtest 'Real work: existing feature' => sub {
my @lines = get_ok_output([$c{prog}, $c{fcheck}, 'base'],
'existing feature');
is scalar @lines, 0, 'good feature output nothing';
};
subtest 'Real work: show the feature version' => sub {
my @lines = get_ok_output([$c{prog}, '-v', $c{fcheck}, 'base'],
'show version');
is_deeply \@lines, [$fcheck_base], 'correct feature version';
};
subtest 'Real work: non-pair feature' => sub {
my @lines = get_ok_output([$c{prog}, $c{fcheck}, 'another'],
'existing feature');
is scalar @lines, 0, 'good feature output nothing';
};
subtest 'Real work: show the non-pair feature version' => sub {
my @lines = get_ok_output([$c{prog}, '-v', $c{fcheck}, 'another'],
'show version');
is_deeply \@lines, ['1.0'], 'correct feature version';
};
subtest 'Real work: different option names' => sub {
my $current_opt = $ENV{FCHECK_TEST_OPT};
for my $opt (qw(--version --features -V)) {
$ENV{FCHECK_TEST_OPT} = $opt;
# Argh, Python argparse won't accept ('-O', $opt)
# if $opt starts with a dash...
my @lines = get_ok_output(
[$c{prog}, "-O$opt", $c{fcheck}, 'base'],
"feature option '$opt'");
is scalar @lines, 0, 'good feature output nothing';
}
$ENV{FCHECK_TEST_OPT} = $current_opt;
};
subtest 'Real work: different features prefix' => sub {
my $current_opt = $ENV{FCHECK_TEST_PREFIX};
for my $pfx ('Features: ', 'V ', 'something/', '--something', '') {
$ENV{FCHECK_TEST_PREFIX} = $pfx || 'EmptyPrefix';
my @lines = get_ok_output(
[$c{prog}, ($pfx ? "-P$pfx" : ('-P', '')), $c{fcheck}, 'base'],
"feature prefix '$pfx'");
is scalar @lines, 0, 'good feature output nothing';
@lines = get_ok_output(
[$c{prog}, '-P', $pfx, $c{fcheck}, 'base'],
"feature split prefix '$pfx'");
is scalar @lines, 0, 'good feature with split prefix output nothing';
}
$ENV{FCHECK_TEST_PREFIX} = $current_opt;
};
subtest 'Real work: unknown feature' => sub {
my @lines = get_error_output([$c{prog}, $c{fcheck}, 'x'],
'unknown feature');
is scalar @lines, 0, 'bad feature output nothing';
};
subtest 'Real work: nonexistent program' => sub {
my @lines = get_error_output([$c{prog}, '/nonexistent', 'x'],
'bad program');
is scalar @lines, 0, 'bad program output nothing';
};
subtest 'Real work: unfeatured program' => sub {
my $old_option = $ENV{FCHECK_TEST_OPT};
$ENV{FCHECK_TEST_OPT} = '--not-features';
my @lines = get_error_output([$c{prog}, $c{fcheck}, 'x'],
'weird program');
is scalar @lines, 0, 'weird program output nothing';
$ENV{FCHECK_TEST_OPT} = $old_option;
};
|
