1#!/usr/bin/env perl
2
3# generate_code.pl
4#
5# This file is part of mbed TLS (https://tls.mbed.org)
6#
7# Copyright (c) 2009-2016, ARM Limited, All Rights Reserved
8#
9# Purpose
10#
11# Generates the test suite code given inputs of the test suite directory that
12# contain the test suites, and the test suite file names for the test code and
13# test data.
14#
15# Usage: generate_code.pl <suite dir> <code file> <data file> [main code file]
16#
17# Structure of files
18#
19#   - main code file - 'main_test.function'
20#       Template file that contains the main() function for the test suite,
21#       test dispatch code as well as support functions. It contains the
22#       following symbols which are substituted by this script during
23#       processing:
24#           TESTCASE_FILENAME
25#           TESTCODE_FILENAME
26#           SUITE_PRE_DEP
27#           MAPPING_CODE
28#           FUNCTION CODE
29#           SUITE_POST_DEP
30#           DEP_CHECK_CODE
31#           DISPATCH_FUNCTION
32#           !LINE_NO!
33#
34#   - common helper code file - 'helpers.function'
35#       Common helper functions
36#
37#   - test suite code file - file name in the form 'test_suite_xxx.function'
38#       Code file that contains the actual test cases. The file contains a
39#       series of code sequences delimited by the following:
40#           BEGIN_HEADER / END_HEADER - list of headers files
41#           BEGIN_SUITE_HELPERS / END_SUITE_HELPERS - helper functions common to
42#               the test suite
43#           BEGIN_CASE / END_CASE - the test cases in the test suite. Each test
44#               case contains at least one function that is used to create the
45#               dispatch code.
46#
47#   - test data file - file name in the form 'test_suite_xxxx.data'
48#       The test case parameters to to be used in execution of the test. The
49#       file name is used to replace the symbol 'TESTCASE_FILENAME' in the main
50#       code file above.
51#
52
53use strict;
54
55my $suite_dir = shift or die "Missing suite directory";
56my $suite_name = shift or die "Missing suite name";
57my $data_name = shift or die "Missing data name";
58my $test_main_file = do { my $arg = shift; defined($arg) ? $arg :  $suite_dir."/main_test.function" };
59my $test_file = $data_name.".c";
60my $test_common_helper_file = $suite_dir."/helpers.function";
61my $test_case_file = $suite_dir."/".$suite_name.".function";
62my $test_case_data = $suite_dir."/".$data_name.".data";
63
64my $line_separator = $/;
65undef $/;
66
67
68#
69# Open and read in the input files
70#
71
72open(TEST_HELPERS, "$test_common_helper_file") or die "Opening test helpers
73'$test_common_helper_file': $!";
74my $test_common_helpers = <TEST_HELPERS>;
75close(TEST_HELPERS);
76
77open(TEST_MAIN, "$test_main_file") or die "Opening test main '$test_main_file': $!";
78my @test_main_lines = split/^/,  <TEST_MAIN>;
79my $test_main;
80my $index = 2;
81for my $line (@test_main_lines) {
82    $line =~ s/!LINE_NO!/$index/;
83    $test_main = $test_main.$line;
84    $index++;
85}
86close(TEST_MAIN);
87
88open(TEST_CASES, "$test_case_file") or die "Opening test cases '$test_case_file': $!";
89my @test_cases_lines = split/^/,  <TEST_CASES>;
90my $test_cases;
91my $index = 2;
92for my $line (@test_cases_lines) {
93    if ($line =~ /^\/\* BEGIN_SUITE_HELPERS .*\*\//)
94    {
95        $line = $line."#line $index \"$test_case_file\"\n";
96    }
97
98    if ($line =~ /^\/\* BEGIN_CASE .*\*\//)
99    {
100        $line = $line."#line $index \"$test_case_file\"\n";
101    }
102
103    $line =~ s/!LINE_NO!/$index/;
104
105    $test_cases = $test_cases.$line;
106    $index++;
107}
108
109close(TEST_CASES);
110
111open(TEST_DATA, "$test_case_data") or die "Opening test data '$test_case_data': $!";
112my $test_data = <TEST_DATA>;
113close(TEST_DATA);
114
115
116#
117# Find the headers, dependencies, and suites in the test cases file
118#
119
120my ( $suite_header ) = $test_cases =~ /\/\* BEGIN_HEADER \*\/\n(.*?)\n\/\* END_HEADER \*\//s;
121my ( $suite_defines ) = $test_cases =~ /\/\* BEGIN_DEPENDENCIES\n \* (.*?)\n \* END_DEPENDENCIES/s;
122my ( $suite_helpers ) = $test_cases =~ /\/\* BEGIN_SUITE_HELPERS \*\/\n(.*?)\n\/\* END_SUITE_HELPERS \*\//s;
123
124my $requirements;
125if ($suite_defines =~ /^depends_on:/)
126{
127    ( $requirements ) = $suite_defines =~ /^depends_on:(.*)$/;
128}
129
130my @var_req_arr = split(/:/, $requirements);
131my $suite_pre_code;
132my $suite_post_code;
133my $dispatch_code;
134my $mapping_code;
135my %mapping_values;
136
137while (@var_req_arr)
138{
139    my $req = shift @var_req_arr;
140    $req =~ s/(!?)(.*)/$1defined($2)/;
141
142    $suite_pre_code .= "#if $req\n";
143    $suite_post_code .= "#endif /* $req */\n";
144}
145
146$/ = $line_separator;
147
148open(TEST_FILE, ">$test_file") or die "Opening destination file '$test_file': $!";
149print TEST_FILE << "END";
150/*
151 * *** THIS FILE HAS BEEN MACHINE GENERATED ***
152 *
153 * This file has been machine generated using the script: $0
154 *
155 * Test file      : $test_file
156 *
157 * The following files were used to create this file.
158 *
159 *      Main code file  : $test_main_file
160 *      Helper file     : $test_common_helper_file
161 *      Test suite file : $test_case_file
162 *      Test suite data : $test_case_data
163 *
164 *
165 *  This file is part of mbed TLS (https://tls.mbed.org)
166 */
167
168#if !defined(MBEDTLS_CONFIG_FILE)
169#include <mbedtls/config.h>
170#else
171#include MBEDTLS_CONFIG_FILE
172#endif
173
174
175/*----------------------------------------------------------------------------*/
176/* Common helper code */
177
178$test_common_helpers
179
180
181/*----------------------------------------------------------------------------*/
182/* Test Suite Code */
183
184$suite_pre_code
185$suite_header
186$suite_helpers
187$suite_post_code
188
189END
190
191$test_main =~ s/SUITE_PRE_DEP/$suite_pre_code/;
192$test_main =~ s/SUITE_POST_DEP/$suite_post_code/;
193
194while($test_cases =~ /\/\* BEGIN_CASE *([\w:]*) \*\/\n(.*?)\n\/\* END_CASE \*\//msg)
195{
196    my $function_deps = $1;
197    my $function_decl = $2;
198
199    # Sanity checks of function
200    if ($function_decl !~ /^#line\s*.*\nvoid /)
201    {
202        die "Test function does not have 'void' as return type.\n" .
203            "Function declaration:\n" .
204            $function_decl;
205    }
206    if ($function_decl !~ /^(#line\s*.*)\nvoid (\w+)\(\s*(.*?)\s*\)\s*{(.*)}/ms)
207    {
208        die "Function declaration not in expected format\n";
209    }
210    my $line_directive = $1;
211    my $function_name = $2;
212    my $function_params = $3;
213    my $function_pre_code;
214    my $function_post_code;
215    my $param_defs;
216    my $param_checks;
217    my @dispatch_params;
218    my @var_def_arr = split(/,\s*/, $function_params);
219    my $i = 1;
220    my $mapping_regex = "".$function_name;
221    my $mapping_count = 0;
222
223    $function_decl =~ s/(^#line\s*.*)\nvoid /$1\nvoid test_suite_/;
224
225    # Add exit label if not present
226    if ($function_decl !~ /^exit:$/m)
227    {
228        $function_decl =~ s/}\s*$/\nexit:\n    return;\n}/;
229    }
230
231    if ($function_deps =~ /^depends_on:/)
232    {
233        ( $function_deps ) = $function_deps =~ /^depends_on:(.*)$/;
234    }
235
236    foreach my $req (split(/:/, $function_deps))
237    {
238        $function_pre_code .= "#ifdef $req\n";
239        $function_post_code .= "#endif /* $req */\n";
240    }
241
242    foreach my $def (@var_def_arr)
243    {
244        # Handle the different parameter types
245        if( substr($def, 0, 4) eq "int " )
246        {
247            $param_defs .= "    int param$i;\n";
248            $param_checks .= "    if( verify_int( params[$i], &param$i ) != 0 ) return( DISPATCH_INVALID_TEST_DATA );\n";
249            push @dispatch_params, "param$i";
250
251            $mapping_regex .= ":([\\d\\w |\\+\\-\\(\\)]+)";
252            $mapping_count++;
253        }
254        elsif( substr($def, 0, 6) eq "char *" )
255        {
256            $param_defs .= "    char *param$i = params[$i];\n";
257            $param_checks .= "    if( verify_string( &param$i ) != 0 ) return( DISPATCH_INVALID_TEST_DATA );\n";
258            push @dispatch_params, "param$i";
259            $mapping_regex .= ":[^:\n]+";
260        }
261        else
262        {
263            die "Parameter declaration not of supported type (int, char *)\n";
264        }
265        $i++;
266
267    }
268
269    # Find non-integer values we should map for this function
270    if( $mapping_count)
271    {
272        my @res = $test_data =~ /^$mapping_regex/msg;
273        foreach my $value (@res)
274        {
275            next unless ($value !~ /^\d+$/);
276            if ( $mapping_values{$value} ) {
277                ${ $mapping_values{$value} }{$function_pre_code} = 1;
278            } else {
279                $mapping_values{$value} = { $function_pre_code => 1 };
280            }
281        }
282    }
283
284    my $call_params = join ", ", @dispatch_params;
285    my $param_count = @var_def_arr + 1;
286    $dispatch_code .= << "END";
287if( strcmp( params[0], "$function_name" ) == 0 )
288{
289$function_pre_code
290$param_defs
291    if( cnt != $param_count )
292    {
293        mbedtls_fprintf( stderr, "\\nIncorrect argument count (%d != %d)\\n", cnt, $param_count );
294        return( DISPATCH_INVALID_TEST_DATA );
295    }
296
297$param_checks
298    test_suite_$function_name( $call_params );
299    return ( DISPATCH_TEST_SUCCESS );
300$function_post_code
301    return ( DISPATCH_UNSUPPORTED_SUITE );
302}
303else
304END
305
306    my $function_code = $function_pre_code . $function_decl . "\n" .
307                        $function_post_code;
308    $test_main =~ s/FUNCTION_CODE/$function_code\nFUNCTION_CODE/;
309}
310
311# Find specific case dependencies that we should be able to check
312# and make check code
313my $dep_check_code;
314
315my @res = $test_data =~ /^depends_on:([\w:]+)/msg;
316my %case_deps;
317foreach my $deps (@res)
318{
319    foreach my $dep (split(/:/, $deps))
320    {
321        $case_deps{$dep} = 1;
322    }
323}
324while( my ($key, $value) = each(%case_deps) )
325{
326    $dep_check_code .= << "END";
327    if( strcmp( str, "$key" ) == 0 )
328    {
329#if defined($key)
330        return( DEPENDENCY_SUPPORTED );
331#else
332        return( DEPENDENCY_NOT_SUPPORTED );
333#endif
334    }
335END
336}
337
338# Make mapping code
339while( my ($key, $value) = each(%mapping_values) )
340{
341    my $key_mapping_code = << "END";
342    if( strcmp( str, "$key" ) == 0 )
343    {
344        *value = ( $key );
345        return( KEY_VALUE_MAPPING_FOUND );
346    }
347END
348
349    # handle depenencies, unless used at least one without depends
350    if ($value->{""}) {
351        $mapping_code .= $key_mapping_code;
352        next;
353    }
354    for my $ifdef ( keys %$value ) {
355        (my $endif = $ifdef) =~ s!ifdef!endif //!g;
356        $mapping_code .= $ifdef . $key_mapping_code . $endif;
357    }
358}
359
360$dispatch_code =~ s/^(.+)/    $1/mg;
361
362$test_main =~ s/TESTCASE_FILENAME/$test_case_data/g;
363$test_main =~ s/TESTCODE_FILENAME/$test_case_file/g;
364$test_main =~ s/FUNCTION_CODE//;
365$test_main =~ s/DEP_CHECK_CODE/$dep_check_code/;
366$test_main =~ s/DISPATCH_FUNCTION/$dispatch_code/;
367$test_main =~ s/MAPPING_CODE/$mapping_code/;
368
369print TEST_FILE << "END";
370$test_main
371END
372
373close(TEST_FILE);
374