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