1#!/usr/bin/env perl
2
3# run-test-suites.pl
4#
5# Copyright The Mbed TLS Contributors
6# SPDX-License-Identifier: Apache-2.0
7#
8# Licensed under the Apache License, Version 2.0 (the "License"); you may
9# not use this file except in compliance with the License.
10# You may obtain a copy of the License at
11#
12# http://www.apache.org/licenses/LICENSE-2.0
13#
14# Unless required by applicable law or agreed to in writing, software
15# distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
16# WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
17# See the License for the specific language governing permissions and
18# limitations under the License.
19
20=head1 SYNOPSIS
21
22Execute all the test suites and print a summary of the results.
23
24 run-test-suites.pl [[-v|--verbose] [VERBOSITY]] [--skip=SUITE[...]]
25
26Options:
27
28  -v|--verbose        Print detailed failure information.
29  -v 2|--verbose=2    Print detailed failure information and summary messages.
30  -v 3|--verbose=3    Print detailed information about every test case.
31  --skip=SUITE[,SUITE...]
32                      Skip the specified SUITE(s). This option can be used
33                      multiple times.
34
35=cut
36
37use warnings;
38use strict;
39
40use utf8;
41use open qw(:std utf8);
42
43use Getopt::Long qw(:config auto_help gnu_compat);
44use Pod::Usage;
45
46my $verbose = 0;
47my @skip_patterns = ();
48GetOptions(
49           'skip=s' => \@skip_patterns,
50           'verbose|v:1' => \$verbose,
51          ) or die;
52
53# All test suites = executable files, excluding source files, debug
54# and profiling information, etc. We can't just grep {! /\./} because
55# some of our test cases' base names contain a dot.
56my @suites = grep { -x $_ || /\.exe$/ } glob 'test_suite_*';
57@suites = grep { !/\.c$/ && !/\.data$/ && -f } @suites;
58die "$0: no test suite found\n" unless @suites;
59
60# "foo" as a skip pattern skips "test_suite_foo" and "test_suite_foo.bar"
61# but not "test_suite_foobar".
62my $skip_re =
63    ( '\Atest_suite_(' .
64      join('|', map {
65          s/[ ,;]/|/g; # allow any of " ,;|" as separators
66          s/\./\./g; # "." in the input means ".", not "any character"
67          $_
68      } @skip_patterns) .
69      ')(\z|\.)' );
70
71# in case test suites are linked dynamically
72$ENV{'LD_LIBRARY_PATH'} = '../library';
73$ENV{'DYLD_LIBRARY_PATH'} = '../library';
74
75my $prefix = $^O eq "MSWin32" ? '' : './';
76
77my ($failed_suites, $total_tests_run, $failed, $suite_cases_passed,
78    $suite_cases_failed, $suite_cases_skipped, $total_cases_passed,
79    $total_cases_failed, $total_cases_skipped );
80my $suites_skipped = 0;
81
82sub pad_print_center {
83    my( $width, $padchar, $string ) = @_;
84    my $padlen = ( $width - length( $string ) - 2 ) / 2;
85    print $padchar x( $padlen ), " $string ", $padchar x( $padlen ), "\n";
86}
87
88for my $suite (@suites)
89{
90    print "$suite ", "." x ( 72 - length($suite) - 2 - 4 ), " ";
91    if( $suite =~ /$skip_re/o ) {
92        print "SKIP\n";
93        ++$suites_skipped;
94        next;
95    }
96
97    my $command = "$prefix$suite";
98    if( $verbose ) {
99        $command .= ' -v';
100    }
101    my $result = `$command`;
102
103    $suite_cases_passed = () = $result =~ /.. PASS/g;
104    $suite_cases_failed = () = $result =~ /.. FAILED/g;
105    $suite_cases_skipped = () = $result =~ /.. ----/g;
106
107    if( $? == 0 ) {
108        print "PASS\n";
109        if( $verbose > 2 ) {
110            pad_print_center( 72, '-', "Begin $suite" );
111            print $result;
112            pad_print_center( 72, '-', "End $suite" );
113        }
114    } else {
115        $failed_suites++;
116        print "FAIL\n";
117        if( $verbose ) {
118            pad_print_center( 72, '-', "Begin $suite" );
119            print $result;
120            pad_print_center( 72, '-', "End $suite" );
121        }
122    }
123
124    my ($passed, $tests, $skipped) = $result =~ /([0-9]*) \/ ([0-9]*) tests.*?([0-9]*) skipped/;
125    $total_tests_run += $tests - $skipped;
126
127    if( $verbose > 1 ) {
128        print "(test cases passed:", $suite_cases_passed,
129                " failed:", $suite_cases_failed,
130                " skipped:", $suite_cases_skipped,
131                " of total:", ($suite_cases_passed + $suite_cases_failed +
132                               $suite_cases_skipped),
133                ")\n"
134    }
135
136    $total_cases_passed += $suite_cases_passed;
137    $total_cases_failed += $suite_cases_failed;
138    $total_cases_skipped += $suite_cases_skipped;
139}
140
141print "-" x 72, "\n";
142print $failed_suites ? "FAILED" : "PASSED";
143printf( " (%d suites, %d tests run%s)\n",
144        scalar(@suites) - $suites_skipped,
145        $total_tests_run,
146        $suites_skipped ? ", $suites_skipped suites skipped" : "" );
147
148if( $verbose > 1 ) {
149    print "  test cases passed :", $total_cases_passed, "\n";
150    print "             failed :", $total_cases_failed, "\n";
151    print "            skipped :", $total_cases_skipped, "\n";
152    print "  of tests executed :", ( $total_cases_passed + $total_cases_failed ),
153            "\n";
154    print " of available tests :",
155            ( $total_cases_passed + $total_cases_failed + $total_cases_skipped ),
156            "\n";
157    if( $suites_skipped != 0 ) {
158        print "Note: $suites_skipped suites were skipped.\n";
159    }
160}
161
162exit( $failed_suites ? 1 : 0 );
163
164