| #!/usr/bin/perl -w |
| |
| # Copyright 2002 Patrik Stridvall |
| # |
| # This library is free software; you can redistribute it and/or |
| # modify it under the terms of the GNU Lesser General Public |
| # License as published by the Free Software Foundation; either |
| # version 2.1 of the License, or (at your option) any later version. |
| # |
| # This library is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| # Lesser General Public License for more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public |
| # License along with this library; if not, write to the Free Software |
| # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| # |
| |
| use strict; |
| |
| BEGIN { |
| $0 =~ m%^(.*?/?tools)/winapi/winapi_test$%; |
| require "$1/winapi/setup.pm"; |
| } |
| |
| use config qw( |
| &file_type &files_skip &files_filter |
| $current_dir $wine_dir $winapi_dir $winapi_check_dir |
| ); |
| use output qw($output); |
| use winapi_test_options qw($options); |
| |
| if($options->progress) { |
| $output->enable_progress; |
| } else { |
| $output->disable_progress; |
| } |
| |
| use c_parser; |
| use tests qw($tests); |
| use type; |
| use util qw(replace_file); |
| |
| my @tests = (); |
| if ($options->pack) { |
| push @tests, "pack"; |
| } |
| |
| my @files = (); |
| { |
| my %files; |
| |
| my %test_dirs; |
| foreach my $test (@tests) { |
| my @test_dirs = $tests->get_test_dirs($test); |
| foreach my $test_dir (@test_dirs) { |
| my @includes = $tests->get_section($test_dir, $test, "include"); |
| foreach my $include (@includes) { |
| $files{"include/$include"} = 1; |
| } |
| } |
| } |
| |
| foreach my $test (@tests) { |
| my @test_dirs = $tests->get_test_dirs($test); |
| foreach my $test_dir (@test_dirs) { |
| my @includes = $tests->get_section($test_dir, $test, "include"); |
| foreach my $include (@includes) { |
| if($files{"include/$include"}) { |
| push @files, "include/$include"; |
| $files{"include/$include"} = 0; |
| } |
| } |
| } |
| } |
| } |
| |
| my %file2types; |
| |
| my $progress_output; |
| my $progress_current = 0; |
| my $progress_max = scalar(@files); |
| |
| ######################################################################## |
| # find_type |
| |
| my %type_name2type; |
| |
| my %defines = ( |
| "ANYSIZE_ARRAY" => 1, |
| "CCHDEVICENAME" => 32, |
| "ELF_VENDOR_SIZE" => 4, |
| "EXCEPTION_MAXIMUM_PARAMETERS" => 15, |
| "HW_PROFILE_GUIDLEN" => 39, |
| "IMAGE_NUMBEROF_DIRECTORY_ENTRIES" => 16, |
| "IMAGE_SIZEOF_SHORT_NAME" => 8, |
| "LF_FACESIZE" => 32, |
| "LF_FULLFACESIZE" => 64, |
| "MAXIMUM_SUPPORTED_EXTENSION" => 512, |
| "MAX_PATH" => 260, |
| "MAX_PROFILE_LEN" => 80, |
| "OFS_MAXPATHNAME" => 128, |
| "SIZE_OF_80387_REGISTERS" => 80, |
| ); |
| |
| my %kludge_reported = ("FILETIME" => 1, "LARGE_INTEGER" => 1); |
| my %parse_reported; |
| |
| sub find_size { |
| my $type_name = shift; |
| |
| local $_ = $type_name; |
| |
| my $count; |
| my $bits; |
| if (s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/) { |
| $count = $2; |
| $bits = $3; |
| } |
| |
| my $size; |
| if (0) { |
| # Nothing |
| } elsif (/\*+$/) { |
| $size = 4; |
| } elsif(/^(?:(?:signed\s+|unsigned\s+)?char)$/) { |
| $size = 1; |
| } elsif (/^(?:(?:signed\s+|unsigned\s+)?short)$/) { |
| $size = 2; |
| } elsif (/^(?:wchar_t)$/) { |
| $size = 2; |
| } elsif (/^(?:(?:signed\s+|unsigned\s+)?(?:__int32|int|long(?:\s+int)?)|unsigned|signed)$/) { |
| $size = 4; |
| } elsif (/^(?:float)$/) { |
| $size = 4; |
| } elsif (/^(?:signed\s+|unsigned\s+)?__int64$/) { |
| $size = 8; |
| } elsif (/^(?:double)$/) { |
| $size = 8; |
| } elsif (/^(?:long\s+double)$/) { |
| $size = 10; # ??? |
| } elsif (/^H(?:DC|BITMAP|BRUSH|ICON|INSTANCE|MENU|METAFILE|WND)$/) { |
| $size = 4; |
| } elsif (/^LP(?:CSTR|CWSTR|DWORD|STR|VOID|THREAD_START_ROUTINE|WSTR)$/) { |
| $size = 4; |
| } elsif (/^(?:(?:MSGBOX)CALLBACK[AW]?|(?:FAR|WND)PROC[AW]?)$/) { |
| $size = 4; |
| } elsif (/^(?:FILETIME|LARGE_INTEGER|LONGLONG)$/) { |
| $size = 8; |
| } elsif (/^(?:CRITICAL_SECTION)$/) { |
| $size = 24; |
| } elsif (/^(?:struct|union)$/) { |
| if (!$parse_reported{$_}) { |
| $output->write("$type_name: can't parse type\n"); |
| $parse_reported{$_} = 1; |
| } |
| $size = undef; |
| } else { |
| $size = undef; |
| } |
| |
| my $size2; |
| if (defined(my $type = $type_name2type{$_})) { |
| $size2 = $type->size; |
| } |
| |
| if (!defined($size)) { |
| $size = $size2; |
| } elsif (defined($size2) && !$kludge_reported{$_}) { |
| $kludge_reported{$_} = 1; |
| $output->write("$type_name: type needn't be kludged\n"); |
| } |
| |
| if (!defined($size)) { |
| # $output->write("$type_name: can't find type\n"); |
| } elsif (defined($count)) { |
| if ($count =~ /^\d+$/) { |
| $size *= int($count); |
| } elsif (defined($count = $defines{$count})) { |
| $size *= int($count); |
| } else { |
| $output->write("$type_name: can't parse type\n"); |
| $size = undef; |
| } |
| } elsif (defined($bits)) { |
| $size = -$bits; |
| } |
| |
| return $size; |
| } |
| |
| foreach my $file (@files) { |
| $progress_current++; |
| |
| { |
| open(IN, "< $wine_dir/$file"); |
| local $/ = undef; |
| $_ = <IN>; |
| close(IN); |
| } |
| |
| my $max_line = 0; |
| { |
| local $_ = $_; |
| while(s/^.*?\n//) { $max_line++; } |
| if($_) { $max_line++; } |
| } |
| |
| my $parser = new c_parser($file); |
| |
| my $line; |
| my $type; |
| my @packs = (4); |
| |
| my $update_output = sub { |
| my $progress = ""; |
| my $prefix = ""; |
| |
| $progress .= "$file (file $progress_current of $progress_max)"; |
| $prefix .= "$file: "; |
| |
| if(defined($line)) { |
| $progress .= ": line $line of $max_line"; |
| } |
| |
| $output->progress($progress); |
| $output->prefix($prefix); |
| }; |
| |
| &$update_output(); |
| |
| my $found_line = sub { |
| $line = shift; |
| |
| &$update_output; |
| }; |
| $parser->set_found_line_callback($found_line); |
| |
| my $found_preprocessor = sub { |
| my $begin_line = shift; |
| my $begin_column = shift; |
| my $preprocessor = shift; |
| |
| local $_ = $preprocessor; |
| if (/^\#\s*include\s+\"pshpack(\d+)\.h\"$/) { |
| push @packs, $1; |
| } elsif(/^\#\s*include\s+\"poppack\.h\"$/) { |
| unshift @packs; |
| } |
| |
| return 1; |
| }; |
| $parser->set_found_preprocessor_callback($found_preprocessor); |
| |
| my $found_type = sub { |
| $type = shift; |
| |
| &$update_output(); |
| |
| if (!defined($type->pack)) { |
| my $pack = $packs[$#packs]; |
| $type->pack($pack); |
| } |
| |
| my $name = $type->name; |
| $file2types{$file}{$name} = $type; |
| |
| my $size = $type->size(\&find_size); |
| if (defined($size)) { |
| foreach my $field ($type->fields(\&find_size)) { |
| my $field_type_name = $field->type_name; |
| my $field_name = $field->name; |
| my $field_size = $field->size; |
| my $field_offset = $field->offset; |
| |
| # $output->write("$name: $field_type_name: $field_name: $field_offset: $field_size\n"); |
| } |
| # $output->write("$name: $size\n"); |
| |
| $type_name2type{$name} = $type; |
| } else { |
| # $output->write("$name: can't find size\n"); |
| } |
| |
| return 1; |
| }; |
| $parser->set_found_type_callback($found_type); |
| |
| { |
| my $line = 1; |
| my $column = 0; |
| if(!$parser->parse_c_file(\$_, \$line, \$column)) { |
| $output->write("can't parse file\n"); |
| } |
| } |
| |
| $output->prefix(""); |
| } |
| |
| ######################################################################## |
| # output_header |
| |
| sub output_header { |
| local *OUT = shift; |
| |
| my $test_dir = shift; |
| my @tests = @{(shift)}; |
| |
| print OUT "/* File generated automatically from tools/winapi/test.dat; do not edit! */\n"; |
| print OUT "/* This file can be copied, modified and distributed without restriction. */\n"; |
| print OUT "\n"; |
| |
| print OUT "/*\n"; |
| foreach my $test (@tests) { |
| my @description = $tests->get_section($test_dir, $test, "description"); |
| foreach my $description (@description) { |
| print OUT " * $description\n"; |
| } |
| } |
| print OUT " */\n"; |
| |
| print OUT "\n"; |
| print OUT "#include <stdio.h>\n"; |
| print OUT "\n"; |
| print OUT "#include \"wine/test.h\"\n"; |
| foreach my $test (@tests) { |
| my @includes = $tests->get_section($test_dir, $test, "include"); |
| foreach my $include (@includes) { |
| print OUT "#include \"$include\"\n"; |
| } |
| } |
| print OUT "\n"; |
| } |
| |
| ######################################################################## |
| # output_footer |
| |
| sub output_footer { |
| local *OUT = shift; |
| |
| my $test_dir = shift; |
| my @tests = @{(shift)}; |
| |
| print OUT "START_TEST(generated)\n"; |
| print OUT "{\n"; |
| foreach my $test (@tests) { |
| print OUT " test_$test();\n"; |
| } |
| print OUT "}\n"; |
| } |
| |
| ######################################################################## |
| # output_test_pack |
| |
| sub output_test_pack { |
| local *OUT = shift; |
| |
| my $test_dir = shift; |
| my $test = shift; |
| |
| my @includes = $tests->get_section($test_dir, $test, "include"); |
| my @type_names = $tests->get_section($test_dir, $test, "struct"); |
| |
| my %type_name_not_used; |
| |
| foreach my $type_name (@type_names) { |
| $type_name_not_used{$type_name} = 1; |
| } |
| |
| foreach my $include (@includes) { |
| my $types = $file2types{"include/$include"}; |
| |
| foreach my $type_name (@type_names) { |
| my $type = $$types{$type_name}; |
| if (!defined($type)) { |
| next; |
| } |
| $type_name_not_used{$type_name} = 0; |
| |
| my $pack = $type->pack; |
| |
| print OUT " /* $type_name */\n"; |
| |
| foreach my $field ($type->fields(\&find_size)) { |
| my $field_type_name = $field->type_name; |
| my $field_name = $field->name; |
| my $field_size = $field->size; |
| my $field_offset = $field->offset; |
| my $field_align = $field->align; |
| |
| next if $field_name eq "" || (defined($field_size) && $field_size < 0); |
| |
| if (defined($field_size) && defined($field_offset)) { |
| print OUT " ok(FIELD_OFFSET($type_name, $field_name) == $field_offset,\n"; |
| print OUT " \"FIELD_OFFSET($type_name, $field_name) == %ld (expected $field_offset)\",\n"; |
| print OUT " FIELD_OFFSET($type_name, $field_name)); /* $field_type_name */\n"; |
| |
| if (0) { |
| print OUT " ok(TYPE_ALIGNMENT($field_type_name) == $field_align,\n"; |
| print OUT " \"TYPE_ALIGNMENT($field_type_name) == %d (expected $field_align)\",\n"; |
| print OUT " TYPE_ALIGNMENT($field_type_name)); /* $field_name */\n"; |
| } |
| } else { |
| $output->write("$type_name: $field_type_name: $field_name: test not generated (offset not defined)\n"); |
| } |
| } |
| |
| my $type_size = $type->size; |
| |
| if (defined($type_size)) { |
| print OUT " ok(sizeof($type_name) == $type_size, "; |
| print OUT "\"sizeof($type_name) == %d (expected $type_size)\", "; |
| print OUT "sizeof($type_name));\n"; |
| print OUT "\n"; |
| } else { |
| $output->write("$type_name: test not generated (size not defined)\n"); |
| } |
| } |
| } |
| |
| foreach my $type_name (@type_names) { |
| if ($type_name_not_used{$type_name}) { |
| $output->write("$test_dir: $test: $type_name: type not found (ignored)\n"); |
| } |
| } |
| } |
| |
| |
| ######################################################################## |
| # output_file |
| |
| sub output_file { |
| local *OUT = shift; |
| |
| my $test_dir = shift; |
| my @tests = @{(shift)}; |
| |
| output_header(\*OUT, $test_dir, \@tests); |
| |
| foreach my $test (@tests) { |
| print OUT "void test_$test(void)\n"; |
| print OUT "{\n"; |
| |
| if ($test eq "pack") { |
| output_test_pack(\*OUT, $test_dir, $test); |
| } else { |
| die "no such test ($test)\n"; |
| } |
| |
| print OUT "}\n"; |
| print OUT "\n"; |
| } |
| |
| output_footer(\*OUT, $test_dir, \@tests); |
| } |
| |
| ######################################################################## |
| # main |
| |
| my @test_dirs = $tests->get_test_dirs(); |
| foreach my $test_dir (@test_dirs) { |
| my $file = "$wine_dir/$test_dir/generated.c"; |
| replace_file($file, \&output_file, $test_dir, \@tests); |
| } |