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