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 with a .datax file.
54my @suites = ();
55for my $data_file (glob 'test_suite_*.datax') {
56    (my $base = $data_file) =~ s/\.datax$//;
57    push @suites, $base if -x $base;
58    push @suites, "$base.exe" if -e "$base.exe";
59}
60die "$0: no test suite found\n" unless @suites;
61
62# "foo" as a skip pattern skips "test_suite_foo" and "test_suite_foo.bar"
63# but not "test_suite_foobar".
64my $skip_re =
65    ( '\Atest_suite_(' .
66      join('|', map {
67          s/[ ,;]/|/g; # allow any of " ,;|" as separators
68          s/\./\./g; # "." in the input means ".", not "any character"
69          $_
70      } @skip_patterns) .
71      ')(\z|\.)' );
72
73# in case test suites are linked dynamically
74$ENV{'LD_LIBRARY_PATH'} = '../library';
75$ENV{'DYLD_LIBRARY_PATH'} = '../library';
76
77my $prefix = $^O eq "MSWin32" ? '' : './';
78
79my (@failed_suites, $total_tests_run, $failed, $suite_cases_passed,
80    $suite_cases_failed, $suite_cases_skipped, $total_cases_passed,
81    $total_cases_failed, $total_cases_skipped );
82my $suites_skipped = 0;
83
84sub pad_print_center {
85    my( $width, $padchar, $string ) = @_;
86    my $padlen = ( $width - length( $string ) - 2 ) / 2;
87    print $padchar x( $padlen ), " $string ", $padchar x( $padlen ), "\n";
88}
89
90for my $suite (@suites)
91{
92    print "$suite ", "." x ( 72 - length($suite) - 2 - 4 ), " ";
93    if( $suite =~ /$skip_re/o ) {
94        print "SKIP\n";
95        ++$suites_skipped;
96        next;
97    }
98
99    my $command = "$prefix$suite";
100    if( $verbose ) {
101        $command .= ' -v';
102    }
103    my $result = `$command`;
104
105    $suite_cases_passed = () = $result =~ /.. PASS/g;
106    $suite_cases_failed = () = $result =~ /.. FAILED/g;
107    $suite_cases_skipped = () = $result =~ /.. ----/g;
108
109    if( $? == 0 ) {
110        print "PASS\n";
111        if( $verbose > 2 ) {
112            pad_print_center( 72, '-', "Begin $suite" );
113            print $result;
114            pad_print_center( 72, '-', "End $suite" );
115        }
116    } else {
117        push @failed_suites, $suite;
118        print "FAIL\n";
119        if( $verbose ) {
120            pad_print_center( 72, '-', "Begin $suite" );
121            print $result;
122            pad_print_center( 72, '-', "End $suite" );
123        }
124    }
125
126    my ($passed, $tests, $skipped) = $result =~ /([0-9]*) \/ ([0-9]*) tests.*?([0-9]*) skipped/;
127    $total_tests_run += $tests - $skipped;
128
129    if( $verbose > 1 ) {
130        print "(test cases passed:", $suite_cases_passed,
131                " failed:", $suite_cases_failed,
132                " skipped:", $suite_cases_skipped,
133                " of total:", ($suite_cases_passed + $suite_cases_failed +
134                               $suite_cases_skipped),
135                ")\n"
136    }
137
138    $total_cases_passed += $suite_cases_passed;
139    $total_cases_failed += $suite_cases_failed;
140    $total_cases_skipped += $suite_cases_skipped;
141}
142
143print "-" x 72, "\n";
144print @failed_suites ? "FAILED" : "PASSED";
145printf( " (%d suites, %d tests run%s)\n",
146        scalar(@suites) - $suites_skipped,
147        $total_tests_run,
148        $suites_skipped ? ", $suites_skipped suites skipped" : "" );
149
150if( $verbose && @failed_suites ) {
151    # the output can be very long, so provide a summary of which suites failed
152    print "      failed suites : @failed_suites\n";
153}
154
155if( $verbose > 1 ) {
156    print "  test cases passed :", $total_cases_passed, "\n";
157    print "             failed :", $total_cases_failed, "\n";
158    print "            skipped :", $total_cases_skipped, "\n";
159    print "  of tests executed :", ( $total_cases_passed + $total_cases_failed ),
160            "\n";
161    print " of available tests :",
162            ( $total_cases_passed + $total_cases_failed + $total_cases_skipped ),
163            "\n";
164    if( $suites_skipped != 0 ) {
165        print "Note: $suites_skipped suites were skipped.\n";
166    }
167}
168
169exit( @failed_suites ? 1 : 0 );
170
171