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
|
#!/usr/bin/env perl
# Copyright (C) 2017 The Qt Company Ltd and/or its subsidiary(-ies).
# SPDX-License-Identifier: LicenseRef-Qt-Commercial OR GPL-3.0-only WITH Qt-GPL-exception-1.0
use 5.010;
use strict;
use warnings;
use utf8;
=head1 NAME
30-parse_build_log.t - various tests for parse_build_log.pl
=head1 SYNOPSIS
perl ./30-parse_build_log.t [pattern1 [pattern2 ...]]
Runs parse_build_log over all the testdata under the `data' directory.
If any patterns are given, only logs with filenames matching those patterns
(regular expressions) will be tested.
perl ./30-parse_build_log.t --update
Runs the test as usual, and updates the testdata such that the test
passes. Use this with care for mass updating of multiple testdata.
=cut
use Getopt::Long qw( GetOptionsFromArray );
use Capture::Tiny qw( capture );
use English qw( -no_match_vars );
use File::Basename;
use File::Slurp;
use File::Spec::Functions;
use FindBin;
use List::MoreUtils qw( none );
use Readonly;
use Test::More;
use Text::Diff;
use autodie;
Readonly my $DATADIR
=> catfile( $FindBin::Bin, 'data' );
Readonly my $PARSE_BUILD_LOG
=> catfile( $FindBin::Bin, '..', 'parse_build_log.pl' );
sub test_from_file
{
my ($file, $update) = @_;
my $testname = basename( $file );
my @expected_lines = read_file( $file );
# first line is special, it's the arguments to pass to parse_build_log;
# the rest is the expected output of parse_build_log
my $args_perl = shift @expected_lines;
my $args_ref = eval $args_perl; ## no critic
if ($EVAL_ERROR) {
die "internal error: while eval'ing first line of $file, `$args_perl': $EVAL_ERROR";
}
if (ref($args_ref) ne 'ARRAY') {
die "internal error: first line of $file, `$args_perl', did not eval to an arrayref";
}
my @command = ( $EXECUTABLE_NAME, $PARSE_BUILD_LOG, @{$args_ref} );
my $status = -1;
my ($stdout, $stderr) = capture {
$status = system( @command );
};
# Basic checks that the command succeeded and didn't print any warnings
is( $status, 0, "$testname - exit code 0" )
|| diag("stdout:\n$stdout\nstderr:\n$stderr");
is( $stderr, q{}, "$testname - no standard error" );
# Now check if the output was really what we expected.
# To get the nicest looking failure messages, we use `diff', so the failure message
# contains exactly the difference between what we wanted and what we got.
my $diff = diff(
\@expected_lines,
\$stdout,
{
STYLE => 'Unified',
FILENAME_A => 'expected',
FILENAME_B => 'actual',
},
);
# Normal mode: just test.
if (!$update) {
ok( !$diff, "$testname - actual matches expected" )
|| diag( $diff );
return;
}
# Update mode: update the testdata if necessary.
my $message = "$testname - actual matches expected";
if ($diff) {
open( my $fh, '>', $file );
print $fh $args_perl.$stdout;
close( $fh );
$message .= " - UPDATED!";
}
pass( $message );
return;
}
sub run
{
my (@args) = @_;
my $update;
GetOptionsFromArray( \@args,
update => \$update,
) || die $!;
foreach my $file (glob "$DATADIR/parsed-logs/*") {
# README.txt is not testdata; treat all other files as testdata
next if ( basename( $file ) eq 'README.txt' );
next if ( ! -f $file );
next if (@args && none { $file =~ qr{$_} } @args);
test_from_file( $file, $update );
}
done_testing;
return;
}
run( @ARGV ) if (!caller);
1;
|
