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 OR GPL-2.0-or-later
7
8=head1 SYNOPSIS
9
10Execute all the test suites and print a summary of the results.
11
12 run-test-suites.pl [[-v|--verbose] [VERBOSITY]] [--skip=SUITE[...]]
13
14Options:
15
16  -v|--verbose        Print detailed failure information.
17  -v 2|--verbose=2    Print detailed failure information and summary messages.
18  -v 3|--verbose=3    Print detailed information about every test case.
19  --skip=SUITE[,SUITE...]
20                      Skip the specified SUITE(s). This option can be used
21                      multiple times.
22
23=cut
24
25use warnings;
26use strict;
27
28use utf8;
29use open qw(:std utf8);
30
31use Getopt::Long qw(:config auto_help gnu_compat);
32use Pod::Usage;
33
34my $verbose = 0;
35my @skip_patterns = ();
36GetOptions(
37           'skip=s' => \@skip_patterns,
38           'verbose|v:1' => \$verbose,
39          ) or die;
40
41# All test suites = executable files with a .datax file.
42my @suites = ();
43for my $data_file (glob 'test_suite_*.datax') {
44    (my $base = $data_file) =~ s/\.datax$//;
45    push @suites, $base if -x $base;
46    push @suites, "$base.exe" if -e "$base.exe";
47}
48die "$0: no test suite found\n" unless @suites;
49
50# "foo" as a skip pattern skips "test_suite_foo" and "test_suite_foo.bar"
51# but not "test_suite_foobar".
52my $skip_re =
53    ( '\Atest_suite_(' .
54      join('|', map {
55          s/[ ,;]/|/g; # allow any of " ,;|" as separators
56          s/\./\./g; # "." in the input means ".", not "any character"
57          $_
58      } @skip_patterns) .
59      ')(\z|\.)' );
60
61# in case test suites are linked dynamically
62$ENV{'LD_LIBRARY_PATH'} = '../library';
63$ENV{'DYLD_LIBRARY_PATH'} = '../library';
64
65my $prefix = $^O eq "MSWin32" ? '' : './';
66
67my (@failed_suites, $total_tests_run, $failed, $suite_cases_passed,
68    $suite_cases_failed, $suite_cases_skipped, $total_cases_passed,
69    $total_cases_failed, $total_cases_skipped );
70my $suites_skipped = 0;
71
72sub pad_print_center {
73    my( $width, $padchar, $string ) = @_;
74    my $padlen = ( $width - length( $string ) - 2 ) / 2;
75    print $padchar x( $padlen ), " $string ", $padchar x( $padlen ), "\n";
76}
77
78for my $suite (@suites)
79{
80    print "$suite ", "." x ( 72 - length($suite) - 2 - 4 ), " ";
81    if( $suite =~ /$skip_re/o ) {
82        print "SKIP\n";
83        ++$suites_skipped;
84        next;
85    }
86
87    my $command = "$prefix$suite";
88    if( $verbose ) {
89        $command .= ' -v';
90    }
91    my $result = `$command`;
92
93    $suite_cases_passed = () = $result =~ /.. PASS/g;
94    $suite_cases_failed = () = $result =~ /.. FAILED/g;
95    $suite_cases_skipped = () = $result =~ /.. ----/g;
96
97    if( $? == 0 ) {
98        print "PASS\n";
99        if( $verbose > 2 ) {
100            pad_print_center( 72, '-', "Begin $suite" );
101            print $result;
102            pad_print_center( 72, '-', "End $suite" );
103        }
104    } else {
105        push @failed_suites, $suite;
106        print "FAIL\n";
107        if( $verbose ) {
108            pad_print_center( 72, '-', "Begin $suite" );
109            print $result;
110            pad_print_center( 72, '-', "End $suite" );
111        }
112    }
113
114    my ($passed, $tests, $skipped) = $result =~ /([0-9]*) \/ ([0-9]*) tests.*?([0-9]*) skipped/;
115    $total_tests_run += $tests - $skipped;
116
117    if( $verbose > 1 ) {
118        print "(test cases passed:", $suite_cases_passed,
119                " failed:", $suite_cases_failed,
120                " skipped:", $suite_cases_skipped,
121                " of total:", ($suite_cases_passed + $suite_cases_failed +
122                               $suite_cases_skipped),
123                ")\n"
124    }
125
126    $total_cases_passed += $suite_cases_passed;
127    $total_cases_failed += $suite_cases_failed;
128    $total_cases_skipped += $suite_cases_skipped;
129}
130
131print "-" x 72, "\n";
132print @failed_suites ? "FAILED" : "PASSED";
133printf( " (%d suites, %d tests run%s)\n",
134        scalar(@suites) - $suites_skipped,
135        $total_tests_run,
136        $suites_skipped ? ", $suites_skipped suites skipped" : "" );
137
138if( $verbose && @failed_suites ) {
139    # the output can be very long, so provide a summary of which suites failed
140    print "      failed suites : @failed_suites\n";
141}
142
143if( $verbose > 1 ) {
144    print "  test cases passed :", $total_cases_passed, "\n";
145    print "             failed :", $total_cases_failed, "\n";
146    print "            skipped :", $total_cases_skipped, "\n";
147    print "  of tests executed :", ( $total_cases_passed + $total_cases_failed ),
148            "\n";
149    print " of available tests :",
150            ( $total_cases_passed + $total_cases_failed + $total_cases_skipped ),
151            "\n";
152    if( $suites_skipped != 0 ) {
153        print "Note: $suites_skipped suites were skipped.\n";
154    }
155}
156
157exit( @failed_suites ? 1 : 0 );
158
159