mirror of
				https://github.com/cuberite/polarssl.git
				synced 2025-10-31 03:30:35 -04:00 
			
		
		
		
	
		
			
				
	
	
		
			412 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			412 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/env perl
 | |
| 
 | |
| # generate_code.pl
 | |
| #
 | |
| # This file is part of mbed TLS (https://tls.mbed.org)
 | |
| #
 | |
| # Copyright (c) 2009-2016, ARM Limited, All Rights Reserved
 | |
| #
 | |
| # Purpose
 | |
| #
 | |
| # Generates the test suite code given inputs of the test suite directory that
 | |
| # contain the test suites, and the test suite file names for the test code and
 | |
| # test data.
 | |
| #
 | |
| # Usage: generate_code.pl <suite dir> <code file> <data file> [main code file]
 | |
| #
 | |
| # Structure of files
 | |
| #
 | |
| #   - main code file - 'main_test.function'
 | |
| #       Template file that contains the main() function for the test suite,
 | |
| #       test dispatch code as well as support functions. It contains the
 | |
| #       following symbols which are substituted by this script during
 | |
| #       processing:
 | |
| #           TESTCASE_FILENAME
 | |
| #           TESTCODE_FILENAME
 | |
| #           SUITE_PRE_DEP
 | |
| #           MAPPING_CODE
 | |
| #           FUNCTION CODE
 | |
| #           SUITE_POST_DEP
 | |
| #           DEP_CHECK_CODE
 | |
| #           DISPATCH_FUNCTION
 | |
| #           !LINE_NO!
 | |
| #
 | |
| #   - common helper code file - 'helpers.function'
 | |
| #       Common helper functions
 | |
| #
 | |
| #   - test suite code file - file name in the form 'test_suite_xxx.function'
 | |
| #       Code file that contains the actual test cases. The file contains a
 | |
| #       series of code sequences delimited by the following:
 | |
| #           BEGIN_HEADER / END_HEADER - list of headers files
 | |
| #           BEGIN_SUITE_HELPERS / END_SUITE_HELPERS - helper functions common to
 | |
| #               the test suite
 | |
| #           BEGIN_CASE / END_CASE - the test cases in the test suite. Each test
 | |
| #               case contains at least one function that is used to create the
 | |
| #               dispatch code.
 | |
| #
 | |
| #   - test data file - file name in the form 'test_suite_xxxx.data'
 | |
| #       The test case parameters to to be used in execution of the test. The
 | |
| #       file name is used to replace the symbol 'TESTCASE_FILENAME' in the main
 | |
| #       code file above.
 | |
| #
 | |
| #       A test data file consists of a sequence of paragraphs separated by
 | |
| #       a single empty line. Line breaks may be in Unix (LF) or Windows (CRLF)
 | |
| #       format. Lines starting with the character '#' are ignored
 | |
| #       (the parser behaves as if they were not present).
 | |
| #
 | |
| #       Each paragraph describes one test case and must consist of: (1) one
 | |
| #       line which is the test case name; (2) an optional line starting with
 | |
| #       the 11-character prefix "depends_on:"; (3) a line containing the test
 | |
| #       function to execute and its parameters.
 | |
| #
 | |
| #       A depends_on: line consists of a list of compile-time options
 | |
| #       separated by the character ':', with no whitespace. The test case
 | |
| #       is executed only if this compilation option is enabled in config.h.
 | |
| #
 | |
| #       The last line of each paragraph contains a test function name and
 | |
| #       a list of parameters separated by the character ':'. Running the
 | |
| #       test case calls this function with the specified parameters. Each
 | |
| #       parameter may either be an integer written in decimal or hexadecimal,
 | |
| #       or a string surrounded by double quotes which may not contain the
 | |
| #       ':' character.
 | |
| #
 | |
| 
 | |
| use strict;
 | |
| 
 | |
| my $suite_dir = shift or die "Missing suite directory";
 | |
| my $suite_name = shift or die "Missing suite name";
 | |
| my $data_name = shift or die "Missing data name";
 | |
| my $test_main_file = do { my $arg = shift; defined($arg) ? $arg :  $suite_dir."/main_test.function" };
 | |
| my $test_file = $data_name.".c";
 | |
| my $test_common_helper_file = $suite_dir."/helpers.function";
 | |
| my $test_case_file = $suite_dir."/".$suite_name.".function";
 | |
| my $test_case_data = $suite_dir."/".$data_name.".data";
 | |
| 
 | |
| my $line_separator = $/;
 | |
| undef $/;
 | |
| 
 | |
| 
 | |
| #
 | |
| # Open and read in the input files
 | |
| #
 | |
| 
 | |
| open(TEST_HELPERS, "$test_common_helper_file") or die "Opening test helpers
 | |
| '$test_common_helper_file': $!";
 | |
| my $test_common_helpers = <TEST_HELPERS>;
 | |
| close(TEST_HELPERS);
 | |
| 
 | |
| open(TEST_MAIN, "$test_main_file") or die "Opening test main '$test_main_file': $!";
 | |
| my @test_main_lines = split/^/,  <TEST_MAIN>;
 | |
| my $test_main;
 | |
| my $index = 2;
 | |
| for my $line (@test_main_lines) {
 | |
|     $line =~ s/!LINE_NO!/$index/;
 | |
|     $test_main = $test_main.$line;
 | |
|     $index++;
 | |
| }
 | |
| close(TEST_MAIN);
 | |
| 
 | |
| open(TEST_CASES, "$test_case_file") or die "Opening test cases '$test_case_file': $!";
 | |
| my @test_cases_lines = split/^/,  <TEST_CASES>;
 | |
| my $test_cases;
 | |
| my $index = 2;
 | |
| for my $line (@test_cases_lines) {
 | |
|     if ($line =~ /^\/\* BEGIN_SUITE_HELPERS .*\*\//)
 | |
|     {
 | |
|         $line = $line."#line $index \"$test_case_file\"\n";
 | |
|     }
 | |
| 
 | |
|     if ($line =~ /^\/\* BEGIN_CASE .*\*\//)
 | |
|     {
 | |
|         $line = $line."#line $index \"$test_case_file\"\n";
 | |
|     }
 | |
| 
 | |
|     $line =~ s/!LINE_NO!/$index/;
 | |
| 
 | |
|     $test_cases = $test_cases.$line;
 | |
|     $index++;
 | |
| }
 | |
| 
 | |
| close(TEST_CASES);
 | |
| 
 | |
| open(TEST_DATA, "$test_case_data") or die "Opening test data '$test_case_data': $!";
 | |
| my $test_data = <TEST_DATA>;
 | |
| close(TEST_DATA);
 | |
| 
 | |
| 
 | |
| #
 | |
| # Find the headers, dependencies, and suites in the test cases file
 | |
| #
 | |
| 
 | |
| my ( $suite_header ) = $test_cases =~ /\/\* BEGIN_HEADER \*\/\n(.*?)\n\/\* END_HEADER \*\//s;
 | |
| my ( $suite_defines ) = $test_cases =~ /\/\* BEGIN_DEPENDENCIES\n \* (.*?)\n \* END_DEPENDENCIES/s;
 | |
| my ( $suite_helpers ) = $test_cases =~ /\/\* BEGIN_SUITE_HELPERS \*\/\n(.*?)\n\/\* END_SUITE_HELPERS \*\//s;
 | |
| 
 | |
| my $requirements;
 | |
| if ($suite_defines =~ /^depends_on:/)
 | |
| {
 | |
|     ( $requirements ) = $suite_defines =~ /^depends_on:(.*)$/;
 | |
| }
 | |
| 
 | |
| my @var_req_arr = split(/:/, $requirements);
 | |
| my $suite_pre_code;
 | |
| my $suite_post_code;
 | |
| my $dispatch_code;
 | |
| my $mapping_code;
 | |
| my %mapping_values;
 | |
| 
 | |
| while (@var_req_arr)
 | |
| {
 | |
|     my $req = shift @var_req_arr;
 | |
|     $req =~ s/(!?)(.*)/$1defined($2)/;
 | |
| 
 | |
|     $suite_pre_code .= "#if $req\n";
 | |
|     $suite_post_code .= "#endif /* $req */\n";
 | |
| }
 | |
| 
 | |
| $/ = $line_separator;
 | |
| 
 | |
| open(TEST_FILE, ">$test_file") or die "Opening destination file '$test_file': $!";
 | |
| print TEST_FILE << "END";
 | |
| /*
 | |
|  * *** THIS FILE HAS BEEN MACHINE GENERATED ***
 | |
|  *
 | |
|  * This file has been machine generated using the script: $0
 | |
|  *
 | |
|  * Test file      : $test_file
 | |
|  *
 | |
|  * The following files were used to create this file.
 | |
|  *
 | |
|  *      Main code file  : $test_main_file
 | |
|  *      Helper file     : $test_common_helper_file
 | |
|  *      Test suite file : $test_case_file
 | |
|  *      Test suite data : $test_case_data
 | |
|  *
 | |
|  *
 | |
|  *  This file is part of mbed TLS (https://tls.mbed.org)
 | |
|  */
 | |
| 
 | |
| #if !defined(MBEDTLS_CONFIG_FILE)
 | |
| #include <mbedtls/config.h>
 | |
| #else
 | |
| #include MBEDTLS_CONFIG_FILE
 | |
| #endif
 | |
| 
 | |
| 
 | |
| /*----------------------------------------------------------------------------*/
 | |
| /* Common helper code */
 | |
| 
 | |
| $test_common_helpers
 | |
| 
 | |
| 
 | |
| /*----------------------------------------------------------------------------*/
 | |
| /* Test Suite Code */
 | |
| 
 | |
| $suite_pre_code
 | |
| $suite_header
 | |
| $suite_helpers
 | |
| $suite_post_code
 | |
| 
 | |
| END
 | |
| 
 | |
| $test_main =~ s/SUITE_PRE_DEP/$suite_pre_code/;
 | |
| $test_main =~ s/SUITE_POST_DEP/$suite_post_code/;
 | |
| 
 | |
| while($test_cases =~ /\/\* BEGIN_CASE *([\w:]*) \*\/\n(.*?)\n\/\* END_CASE \*\//msg)
 | |
| {
 | |
|     my $function_deps = $1;
 | |
|     my $function_decl = $2;
 | |
| 
 | |
|     # Sanity checks of function
 | |
|     if ($function_decl !~ /^#line\s*.*\nvoid /)
 | |
|     {
 | |
|         die "Test function does not have 'void' as return type.\n" .
 | |
|             "Function declaration:\n" .
 | |
|             $function_decl;
 | |
|     }
 | |
|     if ($function_decl !~ /^(#line\s*.*)\nvoid (\w+)\(\s*(.*?)\s*\)\s*{(.*)}/ms)
 | |
|     {
 | |
|         die "Function declaration not in expected format\n";
 | |
|     }
 | |
|     my $line_directive = $1;
 | |
|     my $function_name = $2;
 | |
|     my $function_params = $3;
 | |
|     my $function_pre_code;
 | |
|     my $function_post_code;
 | |
|     my $param_defs;
 | |
|     my $param_checks;
 | |
|     my @dispatch_params;
 | |
|     my @var_def_arr = split(/,\s*/, $function_params);
 | |
|     my $i = 1;
 | |
|     my $mapping_regex = "".$function_name;
 | |
|     my $mapping_count = 0;
 | |
| 
 | |
|     $function_decl =~ s/(^#line\s*.*)\nvoid /$1\nvoid test_suite_/;
 | |
| 
 | |
|     # Add exit label if not present
 | |
|     if ($function_decl !~ /^exit:$/m)
 | |
|     {
 | |
|         $function_decl =~ s/}\s*$/\nexit:\n    return;\n}/;
 | |
|     }
 | |
| 
 | |
|     if ($function_deps =~ /^depends_on:/)
 | |
|     {
 | |
|         ( $function_deps ) = $function_deps =~ /^depends_on:(.*)$/;
 | |
|     }
 | |
| 
 | |
|     foreach my $req (split(/:/, $function_deps))
 | |
|     {
 | |
|         $function_pre_code .= "#ifdef $req\n";
 | |
|         $function_post_code .= "#endif /* $req */\n";
 | |
|     }
 | |
| 
 | |
|     foreach my $def (@var_def_arr)
 | |
|     {
 | |
|         # Handle the different parameter types
 | |
|         if( substr($def, 0, 4) eq "int " )
 | |
|         {
 | |
|             $param_defs .= "    int param$i;\n";
 | |
|             $param_checks .= "    if( verify_int( params[$i], ¶m$i ) != 0 ) return( DISPATCH_INVALID_TEST_DATA );\n";
 | |
|             push @dispatch_params, "param$i";
 | |
| 
 | |
|             $mapping_regex .= ":([\\d\\w |\\+\\-\\(\\)]+)";
 | |
|             $mapping_count++;
 | |
|         }
 | |
|         elsif( substr($def, 0, 6) eq "char *" )
 | |
|         {
 | |
|             $param_defs .= "    char *param$i = params[$i];\n";
 | |
|             $param_checks .= "    if( verify_string( ¶m$i ) != 0 ) return( DISPATCH_INVALID_TEST_DATA );\n";
 | |
|             push @dispatch_params, "param$i";
 | |
|             $mapping_regex .= ":(?:\\\\.|[^:\n])+";
 | |
|         }
 | |
|         else
 | |
|         {
 | |
|             die "Parameter declaration not of supported type (int, char *)\n";
 | |
|         }
 | |
|         $i++;
 | |
| 
 | |
|     }
 | |
| 
 | |
|     # Find non-integer values we should map for this function
 | |
|     if( $mapping_count)
 | |
|     {
 | |
|         my @res = $test_data =~ /^$mapping_regex/msg;
 | |
|         foreach my $value (@res)
 | |
|         {
 | |
|             next unless ($value !~ /^\d+$/);
 | |
|             if ( $mapping_values{$value} ) {
 | |
|                 ${ $mapping_values{$value} }{$function_pre_code} = 1;
 | |
|             } else {
 | |
|                 $mapping_values{$value} = { $function_pre_code => 1 };
 | |
|             }
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     my $call_params = join ", ", @dispatch_params;
 | |
|     my $param_count = @var_def_arr + 1;
 | |
|     $dispatch_code .= << "END";
 | |
| if( strcmp( params[0], "$function_name" ) == 0 )
 | |
| {
 | |
| $function_pre_code
 | |
| $param_defs
 | |
|     if( cnt != $param_count )
 | |
|     {
 | |
|         mbedtls_fprintf( stderr, "\\nIncorrect argument count (%d != %d)\\n", cnt, $param_count );
 | |
|         return( DISPATCH_INVALID_TEST_DATA );
 | |
|     }
 | |
| 
 | |
| $param_checks
 | |
|     test_suite_$function_name( $call_params );
 | |
|     return ( DISPATCH_TEST_SUCCESS );
 | |
| $function_post_code
 | |
|     return ( DISPATCH_UNSUPPORTED_SUITE );
 | |
| }
 | |
| else
 | |
| END
 | |
| 
 | |
|     my $function_code = $function_pre_code . $function_decl . "\n" .
 | |
|                         $function_post_code;
 | |
|     $test_main =~ s/FUNCTION_CODE/$function_code\nFUNCTION_CODE/;
 | |
| }
 | |
| 
 | |
| # Find specific case dependencies that we should be able to check
 | |
| # and make check code
 | |
| my $dep_check_code;
 | |
| 
 | |
| my @res = $test_data =~ /^depends_on:([!:\w]+)/msg;
 | |
| my %case_deps;
 | |
| foreach my $deps (@res)
 | |
| {
 | |
|     foreach my $dep (split(/:/, $deps))
 | |
|     {
 | |
|         $case_deps{$dep} = 1;
 | |
|     }
 | |
| }
 | |
| while( my ($key, $value) = each(%case_deps) )
 | |
| {
 | |
|     if( substr($key, 0, 1) eq "!" )
 | |
|     {
 | |
|         my $key = substr($key, 1);
 | |
|         $dep_check_code .= << "END";
 | |
|     if( strcmp( str, "!$key" ) == 0 )
 | |
|     {
 | |
| #if !defined($key)
 | |
|         return( DEPENDENCY_SUPPORTED );
 | |
| #else
 | |
|         return( DEPENDENCY_NOT_SUPPORTED );
 | |
| #endif
 | |
|     }
 | |
| END
 | |
|     }
 | |
|     else
 | |
|     {
 | |
|         $dep_check_code .= << "END";
 | |
|     if( strcmp( str, "$key" ) == 0 )
 | |
|     {
 | |
| #if defined($key)
 | |
|         return( DEPENDENCY_SUPPORTED );
 | |
| #else
 | |
|         return( DEPENDENCY_NOT_SUPPORTED );
 | |
| #endif
 | |
|     }
 | |
| END
 | |
|     }
 | |
| }
 | |
| 
 | |
| # Make mapping code
 | |
| while( my ($key, $value) = each(%mapping_values) )
 | |
| {
 | |
|     my $key_mapping_code = << "END";
 | |
|     if( strcmp( str, "$key" ) == 0 )
 | |
|     {
 | |
|         *value = ( $key );
 | |
|         return( KEY_VALUE_MAPPING_FOUND );
 | |
|     }
 | |
| END
 | |
| 
 | |
|     # handle depenencies, unless used at least one without depends
 | |
|     if ($value->{""}) {
 | |
|         $mapping_code .= $key_mapping_code;
 | |
|         next;
 | |
|     }
 | |
|     for my $ifdef ( keys %$value ) {
 | |
|         (my $endif = $ifdef) =~ s!ifdef!endif //!g;
 | |
|         $mapping_code .= $ifdef . $key_mapping_code . $endif;
 | |
|     }
 | |
| }
 | |
| 
 | |
| $dispatch_code =~ s/^(.+)/    $1/mg;
 | |
| 
 | |
| $test_main =~ s/TESTCASE_FILENAME/$test_case_data/g;
 | |
| $test_main =~ s/TESTCODE_FILENAME/$test_case_file/g;
 | |
| $test_main =~ s/FUNCTION_CODE//;
 | |
| $test_main =~ s/DEP_CHECK_CODE/$dep_check_code/;
 | |
| $test_main =~ s/DISPATCH_FUNCTION/$dispatch_code/;
 | |
| $test_main =~ s/MAPPING_CODE/$mapping_code/;
 | |
| 
 | |
| print TEST_FILE << "END";
 | |
| $test_main
 | |
| END
 | |
| 
 | |
| close(TEST_FILE);
 | 
