#!/usr/bin/perl # use strict; my $suite_dir = shift or die "Missing suite directory"; my $suite_name = shift or die "Missing suite name"; my $test_file = $suite_name.".c"; my $test_helper_file = $suite_dir."/helpers.function"; my $test_case_file = $suite_dir."/".$suite_name.".function"; my $test_data_file = $suite_dir."/".$suite_name.".data"; open(TEST_DATA, "$test_data_file") or die "Opening test cases '$test_data_file': $!"; my $line_separator = $/; undef $/; open(TEST_HELPERS, "$test_helper_file") or die "Opening test helpers '$test_helper_file': $!"; my $test_helpers = ; close(TEST_HELPERS); open(TEST_CASES, "$test_case_file") or die "Opening test cases '$test_case_file': $!"; my $test_cases = ; close(TEST_CASES); my ( $suite_header ) = $test_cases =~ /BEGIN_HEADER\n(.*?)\nEND_HEADER/s; my ( $suite_defines ) = $test_cases =~ /BEGIN_DEPENDENCIES\n(.*?)\nEND_DEPENDENCIES/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; while (@var_req_arr) { my $req = shift @var_req_arr; $suite_pre_code .= "#ifdef $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"; #include "fct.h" $suite_header $test_helpers FCT_BGN() { $suite_pre_code FCT_SUITE_BGN($suite_name) { END while (my $line = ) { my $description = $line; $line = ; my $test_name = $description; $test_name =~ tr/A-Z \-/a-z__/; $test_name =~ tr/a-z0-9_//cd; # Carve the defines required for this test case my $requirements; if ($line =~ /^depends_on:/) { my $depends_on_line = $line; $line = ; ( $requirements ) = $depends_on_line =~ /^depends_on:(.*)$/; } my @var_req_arr = split(/:/, $requirements); my $pre_code; my $post_code; while (@var_req_arr) { my $req = shift @var_req_arr; $pre_code .= "#ifdef $req\n"; $post_code .= "#endif /* $req */\n"; } my $command_line = $line; $line = ; # Carve the case name and variable values # my ( $case, $var_value ) = $command_line =~ /^([\w_]+):(.*)$/; # Escape the escaped colons (Not really escaped now) # $var_value =~ s/\\:/{colon_sign}/g; # Carve the case and variable definition # my ( $var_def, $case_code ) = $test_cases =~ /BEGIN_CASE\n$case:([^\n]*)\n(.*?)\nEND_CASE/s; my @var_def_arr = split(/:/, $var_def); my @var_value_arr = split(/:/, $var_value); while (@var_def_arr) { my $def = shift @var_def_arr; my $val = shift @var_value_arr; $case_code =~ s/\{$def\}/$val/g; } $case_code = "int ${test_name}_code_present = 0;\nTEST_ASSERT( ${test_name}_code_present == 1 );" if ($case_code =~ /^\s*$/); $case_code =~ s/{colon_sign}/:/g; $case_code =~ s/TEST_ASSERT/fct_chk/g; $case_code =~ s/TEST_EQUALS/fct_chk/g; $case_code =~ s/^/ /gm; print TEST_FILE << "END"; $pre_code FCT_TEST_BGN($test_name) $case_code FCT_TEST_END(); $post_code END } print TEST_FILE << "END"; } FCT_SUITE_END(); $suite_post_code } FCT_END(); END close(TEST_DATA); close(TEST_FILE);