run-test-suites.pl (4769B)
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 10 Execute all the test suites and print a summary of the results. 11 12 run-test-suites.pl [[-v|--verbose] [VERBOSITY]] [--skip=SUITE[...]] 13 14 Options: 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 25 use warnings; 26 use strict; 27 28 use utf8; 29 use open qw(:std utf8); 30 31 use Getopt::Long qw(:config auto_help gnu_compat); 32 use Pod::Usage; 33 34 my $verbose = 0; 35 my @skip_patterns = (); 36 GetOptions( 37 'skip=s' => \@skip_patterns, 38 'verbose|v:1' => \$verbose, 39 ) or die; 40 41 # All test suites = executable files with a .datax file. 42 my @suites = (); 43 for 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 } 48 die "$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". 52 my $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 65 my $prefix = $^O eq "MSWin32" ? '' : './'; 66 67 my (@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 ); 70 my $suites_skipped = 0; 71 72 sub 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 78 for 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 131 print "-" x 72, "\n"; 132 print @failed_suites ? "FAILED" : "PASSED"; 133 printf( " (%d suites, %d tests run%s)\n", 134 scalar(@suites) - $suites_skipped, 135 $total_tests_run, 136 $suites_skipped ? ", $suites_skipped suites skipped" : "" ); 137 138 if( $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 143 if( $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 157 exit( @failed_suites ? 1 : 0 ); 158