30-parse_build_log.t

Enable keyboard shortcuts

#!/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;