1#!/usr/bin/env perl 2# 3 4use strict; 5 6my $suite_dir = shift or die "Missing suite directory"; 7my $suite_name = shift or die "Missing suite name"; 8my $data_name = shift or die "Missing data name"; 9my $test_main_file = do { my $arg = shift; defined($arg) ? $arg : $suite_dir."/main_test.function" }; 10my $test_file = $data_name.".c"; 11my $test_helper_file = $suite_dir."/helpers.function"; 12my $test_case_file = $suite_dir."/".$suite_name.".function"; 13my $test_case_data = $suite_dir."/".$data_name.".data"; 14 15my $line_separator = $/; 16undef $/; 17 18open(TEST_HELPERS, "$test_helper_file") or die "Opening test helpers '$test_helper_file': $!"; 19my $test_helpers = <TEST_HELPERS>; 20close(TEST_HELPERS); 21 22open(TEST_MAIN, "$test_main_file") or die "Opening test main '$test_main_file': $!"; 23my $test_main = <TEST_MAIN>; 24close(TEST_MAIN); 25 26open(TEST_CASES, "$test_case_file") or die "Opening test cases '$test_case_file': $!"; 27my $test_cases = <TEST_CASES>; 28close(TEST_CASES); 29 30open(TEST_DATA, "$test_case_data") or die "Opening test data '$test_case_data': $!"; 31my $test_data = <TEST_DATA>; 32close(TEST_DATA); 33 34my ( $suite_header ) = $test_cases =~ /\/\* BEGIN_HEADER \*\/\n(.*?)\n\/\* END_HEADER \*\//s; 35my ( $suite_defines ) = $test_cases =~ /\/\* BEGIN_DEPENDENCIES\n \* (.*?)\n \* END_DEPENDENCIES/s; 36 37my $requirements; 38if ($suite_defines =~ /^depends_on:/) 39{ 40 ( $requirements ) = $suite_defines =~ /^depends_on:(.*)$/; 41} 42 43my @var_req_arr = split(/:/, $requirements); 44my $suite_pre_code; 45my $suite_post_code; 46my $dispatch_code; 47my $mapping_code; 48my %mapping_values; 49 50while (@var_req_arr) 51{ 52 my $req = shift @var_req_arr; 53 $req =~ s/(!?)(.*)/$1defined($2)/; 54 55 $suite_pre_code .= "#if $req\n"; 56 $suite_post_code .= "#endif /* $req */\n"; 57} 58 59$/ = $line_separator; 60 61open(TEST_FILE, ">$test_file") or die "Opening destination file '$test_file': $!"; 62print TEST_FILE << "END"; 63#if !defined(MBEDTLS_CONFIG_FILE) 64#include <mbedtls/config.h> 65#else 66#include MBEDTLS_CONFIG_FILE 67#endif 68 69$test_helpers 70 71$suite_pre_code 72$suite_header 73$suite_post_code 74 75END 76 77$test_main =~ s/SUITE_PRE_DEP/$suite_pre_code/; 78$test_main =~ s/SUITE_POST_DEP/$suite_post_code/; 79 80while($test_cases =~ /\/\* BEGIN_CASE *([\w:]*) \*\/\n(.*?)\n\/\* END_CASE \*\//msg) 81{ 82 my $function_deps = $1; 83 my $function_decl = $2; 84 85 # Sanity checks of function 86 if ($function_decl !~ /^void /) 87 { 88 die "Test function does not have 'void' as return type\n"; 89 } 90 if ($function_decl !~ /^void (\w+)\(\s*(.*?)\s*\)\s*{(.*)}/ms) 91 { 92 die "Function declaration not in expected format\n"; 93 } 94 my $function_name = $1; 95 my $function_params = $2; 96 my $function_pre_code; 97 my $function_post_code; 98 my $param_defs; 99 my $param_checks; 100 my @dispatch_params; 101 my @var_def_arr = split(/,\s*/, $function_params); 102 my $i = 1; 103 my $mapping_regex = "".$function_name; 104 my $mapping_count = 0; 105 106 $function_decl =~ s/^void /void test_suite_/; 107 108 # Add exit label if not present 109 if ($function_decl !~ /^exit:$/m) 110 { 111 $function_decl =~ s/}\s*$/\nexit:\n return;\n}/; 112 } 113 114 if ($function_deps =~ /^depends_on:/) 115 { 116 ( $function_deps ) = $function_deps =~ /^depends_on:(.*)$/; 117 } 118 119 foreach my $req (split(/:/, $function_deps)) 120 { 121 $function_pre_code .= "#ifdef $req\n"; 122 $function_post_code .= "#endif /* $req */\n"; 123 } 124 125 foreach my $def (@var_def_arr) 126 { 127 # Handle the different parameter types 128 if( substr($def, 0, 4) eq "int " ) 129 { 130 $param_defs .= " int param$i;\n"; 131 $param_checks .= " if( verify_int( params[$i], ¶m$i ) != 0 ) return( 2 );\n"; 132 push @dispatch_params, "param$i"; 133 134 $mapping_regex .= ":([\\d\\w |\\+\\-\\(\\)]+)"; 135 $mapping_count++; 136 } 137 elsif( substr($def, 0, 6) eq "char *" ) 138 { 139 $param_defs .= " char *param$i = params[$i];\n"; 140 $param_checks .= " if( verify_string( ¶m$i ) != 0 ) return( 2 );\n"; 141 push @dispatch_params, "param$i"; 142 $mapping_regex .= ":[^:\n]+"; 143 } 144 else 145 { 146 die "Parameter declaration not of supported type (int, char *)\n"; 147 } 148 $i++; 149 150 } 151 152 # Find non-integer values we should map for this function 153 if( $mapping_count) 154 { 155 my @res = $test_data =~ /^$mapping_regex/msg; 156 foreach my $value (@res) 157 { 158 next unless ($value !~ /^\d+$/); 159 if ( $mapping_values{$value} ) { 160 ${ $mapping_values{$value} }{$function_pre_code} = 1; 161 } else { 162 $mapping_values{$value} = { $function_pre_code => 1 }; 163 } 164 } 165 } 166 167 my $call_params = join ", ", @dispatch_params; 168 my $param_count = @var_def_arr + 1; 169 $dispatch_code .= << "END"; 170if( strcmp( params[0], "$function_name" ) == 0 ) 171{ 172$function_pre_code 173$param_defs 174 if( cnt != $param_count ) 175 { 176 mbedtls_fprintf( stderr, "\\nIncorrect argument count (%d != %d)\\n", cnt, $param_count ); 177 return( 2 ); 178 } 179 180$param_checks 181 test_suite_$function_name( $call_params ); 182 return ( 0 ); 183$function_post_code 184 return ( 3 ); 185} 186else 187END 188 189 my $function_code = $function_pre_code . $function_decl . "\n" . $function_post_code; 190 $test_main =~ s/FUNCTION_CODE/$function_code\nFUNCTION_CODE/; 191} 192 193# Find specific case dependencies that we should be able to check 194# and make check code 195my $dep_check_code; 196 197my @res = $test_data =~ /^depends_on:([\w:]+)/msg; 198my %case_deps; 199foreach my $deps (@res) 200{ 201 foreach my $dep (split(/:/, $deps)) 202 { 203 $case_deps{$dep} = 1; 204 } 205} 206while( my ($key, $value) = each(%case_deps) ) 207{ 208 $dep_check_code .= << "END"; 209 if( strcmp( str, "$key" ) == 0 ) 210 { 211#if defined($key) 212 return( 0 ); 213#else 214 return( 1 ); 215#endif 216 } 217END 218} 219 220# Make mapping code 221while( my ($key, $value) = each(%mapping_values) ) 222{ 223 my $key_mapping_code = << "END"; 224 if( strcmp( str, "$key" ) == 0 ) 225 { 226 *value = ( $key ); 227 return( 0 ); 228 } 229END 230 231 # handle depenencies, unless used at least one without depends 232 if ($value->{""}) { 233 $mapping_code .= $key_mapping_code; 234 next; 235 } 236 for my $ifdef ( keys %$value ) { 237 (my $endif = $ifdef) =~ s!ifdef!endif //!g; 238 $mapping_code .= $ifdef . $key_mapping_code . $endif; 239 } 240} 241 242$dispatch_code =~ s/^(.+)/ $1/mg; 243 244$test_main =~ s/TEST_FILENAME/$test_case_data/; 245$test_main =~ s/FUNCTION_CODE//; 246$test_main =~ s/DEP_CHECK_CODE/$dep_check_code/; 247$test_main =~ s/DISPATCH_FUNCTION/$dispatch_code/; 248$test_main =~ s/MAPPING_CODE/$mapping_code/; 249 250print TEST_FILE << "END"; 251$test_main 252END 253 254close(TEST_FILE); 255