blob: d6134bc6b90ccde3c30628f8f1f6fd846520fbdb [file] [log] [blame]
Markus Pfeiffera26a0052014-04-22 20:16:15 +00001#!/usr/bin/env perl
Paul Bakker367dae42009-06-28 21:50:27 +00002#
Gilles Peskinee38900b2017-09-29 15:45:12 +02003# A test data file consists of a sequence of paragraphs separated by
4# a single empty line. Line breaks may be in Unix (LF) or Windows (CRLF)
5# format. Lines starting with the character '#' are ignored
6# (the parser behaves as if they were not present).
7#
8# Each paragraph describes one test case and must consist of: (1) one
9# line which is the test case name; (2) an optional line starting with
10# the 11-character prefix "depends_on:"; (3) a line containing the test
11# function to execute and its parameters.
12#
13# A depends_on: line consists of a list of compile-time options
14# separated by the character ':', with no whitespace. The test case
15# is executed only if this compilation option is enabled in config.h.
16#
17# The last line of each paragraph contains a test function name and
18# a list of parameters separated by the character ':'. Running the
19# test case calls this function with the specified parameters. Each
20# parameter may either be an integer written in decimal or hexadecimal,
21# or a string surrounded by double quotes which may not contain the
22# ':' character.
23#
Paul Bakker367dae42009-06-28 21:50:27 +000024
25use strict;
26
27my $suite_dir = shift or die "Missing suite directory";
28my $suite_name = shift or die "Missing suite name";
Paul Bakker46c17942011-07-13 14:54:54 +000029my $data_name = shift or die "Missing data name";
Rich Evansf4253c72015-01-14 19:23:00 +000030my $test_main_file = do { my $arg = shift; defined($arg) ? $arg : $suite_dir."/main_test.function" };
Paul Bakker46c17942011-07-13 14:54:54 +000031my $test_file = $data_name.".c";
Paul Bakker367dae42009-06-28 21:50:27 +000032my $test_helper_file = $suite_dir."/helpers.function";
33my $test_case_file = $suite_dir."/".$suite_name.".function";
Paul Bakker19343182013-08-16 13:31:10 +020034my $test_case_data = $suite_dir."/".$data_name.".data";
Paul Bakker367dae42009-06-28 21:50:27 +000035
36my $line_separator = $/;
37undef $/;
38
39open(TEST_HELPERS, "$test_helper_file") or die "Opening test helpers '$test_helper_file': $!";
40my $test_helpers = <TEST_HELPERS>;
41close(TEST_HELPERS);
42
Paul Bakker19343182013-08-16 13:31:10 +020043open(TEST_MAIN, "$test_main_file") or die "Opening test main '$test_main_file': $!";
44my $test_main = <TEST_MAIN>;
45close(TEST_MAIN);
46
Paul Bakker367dae42009-06-28 21:50:27 +000047open(TEST_CASES, "$test_case_file") or die "Opening test cases '$test_case_file': $!";
48my $test_cases = <TEST_CASES>;
49close(TEST_CASES);
Paul Bakker19343182013-08-16 13:31:10 +020050
51open(TEST_DATA, "$test_case_data") or die "Opening test data '$test_case_data': $!";
52my $test_data = <TEST_DATA>;
53close(TEST_DATA);
54
Paul Bakker33b43f12013-08-20 11:48:36 +020055my ( $suite_header ) = $test_cases =~ /\/\* BEGIN_HEADER \*\/\n(.*?)\n\/\* END_HEADER \*\//s;
56my ( $suite_defines ) = $test_cases =~ /\/\* BEGIN_DEPENDENCIES\n \* (.*?)\n \* END_DEPENDENCIES/s;
Paul Bakker5690efc2011-05-26 13:16:06 +000057
58my $requirements;
59if ($suite_defines =~ /^depends_on:/)
60{
61 ( $requirements ) = $suite_defines =~ /^depends_on:(.*)$/;
62}
Paul Bakker19343182013-08-16 13:31:10 +020063
Paul Bakker5690efc2011-05-26 13:16:06 +000064my @var_req_arr = split(/:/, $requirements);
65my $suite_pre_code;
66my $suite_post_code;
Paul Bakker19343182013-08-16 13:31:10 +020067my $dispatch_code;
68my $mapping_code;
69my %mapping_values;
Paul Bakker5690efc2011-05-26 13:16:06 +000070
71while (@var_req_arr)
72{
73 my $req = shift @var_req_arr;
Manuel Pégourié-Gonnarde46c6c32015-03-23 13:59:10 +010074 $req =~ s/(!?)(.*)/$1defined($2)/;
Paul Bakker5690efc2011-05-26 13:16:06 +000075
Manuel Pégourié-Gonnarde46c6c32015-03-23 13:59:10 +010076 $suite_pre_code .= "#if $req\n";
Paul Bakker5690efc2011-05-26 13:16:06 +000077 $suite_post_code .= "#endif /* $req */\n";
78}
Paul Bakker367dae42009-06-28 21:50:27 +000079
80$/ = $line_separator;
81
82open(TEST_FILE, ">$test_file") or die "Opening destination file '$test_file': $!";
83print TEST_FILE << "END";
Manuel Pégourié-Gonnard2cf5a7c2015-04-08 12:49:31 +020084#if !defined(MBEDTLS_CONFIG_FILE)
Manuel Pégourié-Gonnard7f809972015-03-09 17:05:11 +000085#include <mbedtls/config.h>
Manuel Pégourié-Gonnardcef4ad22014-04-29 12:39:06 +020086#else
Manuel Pégourié-Gonnard2cf5a7c2015-04-08 12:49:31 +020087#include MBEDTLS_CONFIG_FILE
Manuel Pégourié-Gonnardcef4ad22014-04-29 12:39:06 +020088#endif
Paul Bakker5690efc2011-05-26 13:16:06 +000089
Rich Evans00ab4702015-02-06 13:43:58 +000090$test_helpers
91
Paul Bakkerde56ca12013-09-15 17:05:21 +020092$suite_pre_code
Paul Bakker367dae42009-06-28 21:50:27 +000093$suite_header
Paul Bakkerde56ca12013-09-15 17:05:21 +020094$suite_post_code
Paul Bakker367dae42009-06-28 21:50:27 +000095
Paul Bakker367dae42009-06-28 21:50:27 +000096END
97
Paul Bakkerb34fef22013-08-20 12:06:33 +020098$test_main =~ s/SUITE_PRE_DEP/$suite_pre_code/;
99$test_main =~ s/SUITE_POST_DEP/$suite_post_code/;
100
Paul Bakker33b43f12013-08-20 11:48:36 +0200101while($test_cases =~ /\/\* BEGIN_CASE *([\w:]*) \*\/\n(.*?)\n\/\* END_CASE \*\//msg)
Paul Bakker367dae42009-06-28 21:50:27 +0000102{
Paul Bakker19343182013-08-16 13:31:10 +0200103 my $function_deps = $1;
Paul Bakker33b43f12013-08-20 11:48:36 +0200104 my $function_decl = $2;
105
106 # Sanity checks of function
107 if ($function_decl !~ /^void /)
108 {
109 die "Test function does not have 'void' as return type\n";
110 }
Paul Bakker318d0fe2014-07-10 14:59:25 +0200111 if ($function_decl !~ /^void (\w+)\(\s*(.*?)\s*\)\s*{(.*)}/ms)
Paul Bakker33b43f12013-08-20 11:48:36 +0200112 {
113 die "Function declaration not in expected format\n";
114 }
115 my $function_name = $1;
116 my $function_params = $2;
Paul Bakker19343182013-08-16 13:31:10 +0200117 my $function_pre_code;
118 my $function_post_code;
Paul Bakker19343182013-08-16 13:31:10 +0200119 my $param_defs;
120 my $param_checks;
121 my @dispatch_params;
Paul Bakker33b43f12013-08-20 11:48:36 +0200122 my @var_def_arr = split(/,\s*/, $function_params);
Paul Bakker19343182013-08-16 13:31:10 +0200123 my $i = 1;
124 my $mapping_regex = "".$function_name;
125 my $mapping_count = 0;
Paul Bakker367dae42009-06-28 21:50:27 +0000126
Paul Bakker33b43f12013-08-20 11:48:36 +0200127 $function_decl =~ s/^void /void test_suite_/;
128
Paul Bakker318d0fe2014-07-10 14:59:25 +0200129 # Add exit label if not present
130 if ($function_decl !~ /^exit:$/m)
131 {
132 $function_decl =~ s/}\s*$/\nexit:\n return;\n}/;
133 }
134
Paul Bakker19343182013-08-16 13:31:10 +0200135 if ($function_deps =~ /^depends_on:/)
Paul Bakkerccff1672009-10-03 19:57:10 +0000136 {
Paul Bakker19343182013-08-16 13:31:10 +0200137 ( $function_deps ) = $function_deps =~ /^depends_on:(.*)$/;
Paul Bakkerccff1672009-10-03 19:57:10 +0000138 }
139
Paul Bakker19343182013-08-16 13:31:10 +0200140 foreach my $req (split(/:/, $function_deps))
Paul Bakker367dae42009-06-28 21:50:27 +0000141 {
Paul Bakker19343182013-08-16 13:31:10 +0200142 $function_pre_code .= "#ifdef $req\n";
143 $function_post_code .= "#endif /* $req */\n";
Paul Bakker367dae42009-06-28 21:50:27 +0000144 }
Paul Bakker367dae42009-06-28 21:50:27 +0000145
Paul Bakker19343182013-08-16 13:31:10 +0200146 foreach my $def (@var_def_arr)
147 {
148 # Handle the different parameter types
Paul Bakker33b43f12013-08-20 11:48:36 +0200149 if( substr($def, 0, 4) eq "int " )
Paul Bakker19343182013-08-16 13:31:10 +0200150 {
151 $param_defs .= " int param$i;\n";
152 $param_checks .= " if( verify_int( params[$i], &param$i ) != 0 ) return( 2 );\n";
153 push @dispatch_params, "param$i";
Paul Bakker367dae42009-06-28 21:50:27 +0000154
Paul Bakker19343182013-08-16 13:31:10 +0200155 $mapping_regex .= ":([\\d\\w |\\+\\-\\(\\)]+)";
156 $mapping_count++;
157 }
Paul Bakker33b43f12013-08-20 11:48:36 +0200158 elsif( substr($def, 0, 6) eq "char *" )
Paul Bakker19343182013-08-16 13:31:10 +0200159 {
160 $param_defs .= " char *param$i = params[$i];\n";
161 $param_checks .= " if( verify_string( &param$i ) != 0 ) return( 2 );\n";
162 push @dispatch_params, "param$i";
Andres AGf083b312017-02-02 14:36:49 +0000163 $mapping_regex .= ":(?:\\\\.|[^:\n])+";
Paul Bakker19343182013-08-16 13:31:10 +0200164 }
Paul Bakker33b43f12013-08-20 11:48:36 +0200165 else
166 {
167 die "Parameter declaration not of supported type (int, char *)\n";
168 }
Paul Bakker19343182013-08-16 13:31:10 +0200169 $i++;
Paul Bakker367dae42009-06-28 21:50:27 +0000170
Paul Bakker19343182013-08-16 13:31:10 +0200171 }
172
173 # Find non-integer values we should map for this function
174 if( $mapping_count)
175 {
176 my @res = $test_data =~ /^$mapping_regex/msg;
177 foreach my $value (@res)
178 {
Manuel Pégourié-Gonnard18c443d2013-10-17 14:58:24 +0200179 next unless ($value !~ /^\d+$/);
180 if ( $mapping_values{$value} ) {
181 ${ $mapping_values{$value} }{$function_pre_code} = 1;
182 } else {
183 $mapping_values{$value} = { $function_pre_code => 1 };
184 }
Paul Bakker19343182013-08-16 13:31:10 +0200185 }
186 }
187
188 my $call_params = join ", ", @dispatch_params;
189 my $param_count = @var_def_arr + 1;
190 $dispatch_code .= << "END";
191if( strcmp( params[0], "$function_name" ) == 0 )
192{
193$function_pre_code
194$param_defs
195 if( cnt != $param_count )
196 {
Manuel Pégourié-Gonnard2cf5a7c2015-04-08 12:49:31 +0200197 mbedtls_fprintf( stderr, "\\nIncorrect argument count (%d != %d)\\n", cnt, $param_count );
Paul Bakker19343182013-08-16 13:31:10 +0200198 return( 2 );
199 }
200
201$param_checks
Paul Bakker33b43f12013-08-20 11:48:36 +0200202 test_suite_$function_name( $call_params );
203 return ( 0 );
Paul Bakker19343182013-08-16 13:31:10 +0200204$function_post_code
205 return ( 3 );
206}
207else
208END
209
Paul Bakker33b43f12013-08-20 11:48:36 +0200210 my $function_code = $function_pre_code . $function_decl . "\n" . $function_post_code;
211 $test_main =~ s/FUNCTION_CODE/$function_code\nFUNCTION_CODE/;
Paul Bakker19343182013-08-16 13:31:10 +0200212}
213
214# Find specific case dependencies that we should be able to check
215# and make check code
216my $dep_check_code;
217
218my @res = $test_data =~ /^depends_on:([\w:]+)/msg;
219my %case_deps;
220foreach my $deps (@res)
221{
222 foreach my $dep (split(/:/, $deps))
223 {
224 $case_deps{$dep} = 1;
225 }
226}
227while( my ($key, $value) = each(%case_deps) )
228{
229 $dep_check_code .= << "END";
230 if( strcmp( str, "$key" ) == 0 )
231 {
232#if defined($key)
233 return( 0 );
234#else
235 return( 1 );
236#endif
237 }
Paul Bakker367dae42009-06-28 21:50:27 +0000238END
239}
240
Paul Bakker19343182013-08-16 13:31:10 +0200241# Make mapping code
242while( my ($key, $value) = each(%mapping_values) )
243{
Manuel Pégourié-Gonnard18c443d2013-10-17 14:58:24 +0200244 my $key_mapping_code = << "END";
Paul Bakker19343182013-08-16 13:31:10 +0200245 if( strcmp( str, "$key" ) == 0 )
246 {
247 *value = ( $key );
248 return( 0 );
249 }
250END
Manuel Pégourié-Gonnard18c443d2013-10-17 14:58:24 +0200251
252 # handle depenencies, unless used at least one without depends
253 if ($value->{""}) {
254 $mapping_code .= $key_mapping_code;
255 next;
256 }
257 for my $ifdef ( keys %$value ) {
258 (my $endif = $ifdef) =~ s!ifdef!endif //!g;
259 $mapping_code .= $ifdef . $key_mapping_code . $endif;
260 }
Paul Bakker19343182013-08-16 13:31:10 +0200261}
262
263$dispatch_code =~ s/^(.+)/ $1/mg;
264
265$test_main =~ s/TEST_FILENAME/$test_case_data/;
266$test_main =~ s/FUNCTION_CODE//;
267$test_main =~ s/DEP_CHECK_CODE/$dep_check_code/;
268$test_main =~ s/DISPATCH_FUNCTION/$dispatch_code/;
269$test_main =~ s/MAPPING_CODE/$mapping_code/;
270
Paul Bakker367dae42009-06-28 21:50:27 +0000271print TEST_FILE << "END";
Paul Bakker19343182013-08-16 13:31:10 +0200272$test_main
Paul Bakker367dae42009-06-28 21:50:27 +0000273END
274
Paul Bakker367dae42009-06-28 21:50:27 +0000275close(TEST_FILE);