#!/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 @headers = $tests->get_section($test_dir, $test, "header"); foreach my $header (@headers) { $files{"include/$header"} = 1; } } } foreach my $test (@tests) { my @test_dirs = $tests->get_test_dirs($test); foreach my $test_dir (@test_dirs) { my @headers = $tests->get_section($test_dir, $test, "header"); foreach my $header (@headers) { if($files{"include/$header"}) { push @files, "include/$header"; $files{"include/$header"} = 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, "TOKEN_SOURCE_LENGTH" => 8, ); my %align_kludge_reported = ("FILETIME" => 1, "LARGE_INTEGER" => 1); sub find_align { my $type_name = shift; local $_ = $type_name; # Remove "count" and "bits" s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/; my $align; if (0) { # Nothing } elsif (/\*+$/) { $align = 4; } elsif(/^(?:(?:signed\s+|unsigned\s+)?char)$/) { $align = 1; } elsif (/^(?:(?:signed\s+|unsigned\s+)?short)$/) { $align = 2; } elsif (/^(?:wchar_t)$/) { $align = 2; } elsif (/^(?:(?:signed\s+|unsigned\s+)?(?:__int32|int|long(?:\s+int)?)|unsigned|signed)$/) { $align = 4; } elsif (/^(?:float)$/) { $align = 4; } elsif (/^(?:signed\s+|unsigned\s+)?__int64$/) { $align = 4; } elsif (/^(?:double)$/) { $align = 4; } elsif (/^(?:long\s+double)$/) { $align = 4; } elsif (/^H(?:DC|BITMAP|BRUSH|ICON|INSTANCE|MENU|METAFILE|WND)$/) { $align = 4; } elsif (/^LP(?:CSTR|CWSTR|DWORD|STR|VOID|THREAD_START_ROUTINE|WSTR)$/) { $align = 4; } elsif (/^(?:(?:MSGBOX)CALLBACK[AW]?|(?:FAR|WND)PROC[AW]?)$/) { $align = 4; } elsif (/^(?:FILETIME|LARGE_INTEGER|LONGLONG)$/) { $align = 4; } else { $align = undef; } my $align2; if (defined(my $type = $type_name2type{$_})) { $align2 = $type->align; } if (!defined($align)) { $align = $align2; } elsif (defined($align2) && !$align_kludge_reported{$_}) { $align_kludge_reported{$_} = 1; $output->write("$type_name: type needn't be kludged\n"); } if (!defined($align)) { # $output->write("$type_name: can't find type\n"); } return $align; } my %size_kludge_reported = ("FILETIME" => 1, "LARGE_INTEGER" => 1); my %size_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 (/^(?:struct|union)$/) { if (!$size_parse_reported{$_}) { $output->write("$type_name: can't parse type\n"); $size_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) && !$size_kludge_reported{$_}) { $size_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; $_ = ; 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\"$/) { pop @packs; } return 1; }; $parser->set_found_preprocessor_callback($found_preprocessor); my $found_type = sub { $type = shift; &$update_output(); my $name = $type->name; $file2types{$file}{$name} = $type; $type->set_find_align_callback(\&find_align); $type->set_find_size_callback(\&find_size); my $pack = $packs[$#packs]; if (!defined($type->pack)) { $type->pack($pack); } my $size = $type->size(); if (defined($size)) { my $max_field_base_size = 0; foreach my $field ($type->fields()) { my $field_type_name = $field->type_name; my $field_name = $field->name; my $field_size = $field->size; my $field_base_size = $field->base_size; my $field_offset = $field->offset; my $field_align = $field->align; # $output->write("$name: $field_type_name: $field_name: $field_offset: $field_size($field_base_size): $field_align\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 "#define WINVER 0x0501\n"; print OUT "#define _WIN32_WINNT 0x0501\n"; print OUT "\n"; print OUT "#define WINE_NOWINSOCK\n"; print OUT "\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"; print OUT "#include \"wine/test.h\"\n"; print OUT "\n"; print OUT "/***********************************************************************\n"; print OUT " * Compability macros\n"; print OUT " */\n"; print OUT "\n"; print OUT "#define DWORD_PTR UINT_PTR\n"; print OUT "#define LONG_PTR INT_PTR\n"; print OUT "#define ULONG_PTR UINT_PTR\n"; print OUT "\n"; print OUT "/***********************************************************************\n"; print OUT " * Windows API extension\n"; print OUT " */\n"; print OUT "\n"; print OUT "#if (_MSC_VER >= 1300) && defined(__cplusplus)\n"; print OUT "# define FIELD_ALIGNMENT(type, field) __alignof(((type*)0)->field)\n"; print OUT "#elif defined(__GNUC__)\n"; print OUT "# define FIELD_ALIGNMENT(type, field) __alignof__(((type*)0)->field)\n"; print OUT "#else\n"; print OUT "/* FIXME: Not sure if is possible to do without compiler extension */\n"; print OUT "#endif\n"; print OUT "\n"; print OUT "/***********************************************************************\n"; print OUT " * Test helper macros\n"; print OUT " */\n"; print OUT "\n"; print OUT "#ifdef FIELD_ALIGNMENT\n"; print OUT "# define TEST_FIELD_ALIGNMENT(type, field, align) \\\n"; print OUT " ok(FIELD_ALIGNMENT(type, field) == align, \\\n"; print OUT " \"FIELD_ALIGNMENT(\" #type \", \" #field \") == %d (expected \" #align \")\", \\\n"; print OUT " FIELD_ALIGNMENT(type, field))\n"; print OUT "#else\n"; print OUT "# define TEST_FIELD_ALIGNMENT(type, field, align) do { } while (0)\n"; print OUT "#endif\n"; print OUT "\n"; print OUT "#define TEST_FIELD_OFFSET(type, field, offset) \\\n"; print OUT " ok(FIELD_OFFSET(type, field) == offset, \\\n"; print OUT " \"FIELD_OFFSET(\" #type \", \" #field \") == %ld (expected \" #offset \")\", \\\n"; print OUT " FIELD_OFFSET(type, field))\n"; print OUT "\n"; print OUT "#define TEST_TYPE_ALIGNMENT(type, align) \\\n"; print OUT " ok(TYPE_ALIGNMENT(type) == align, \"TYPE_ALIGNMENT(\" #type \") == %d (expected \" #align \")\", TYPE_ALIGNMENT(type))\n"; print OUT "\n"; print OUT "#define TEST_TYPE_SIZE(type, size) \\\n"; print OUT " ok(sizeof(type) == size, \"sizeof(\" #type \") == %d (expected \" #size \")\", sizeof(type))\n"; print OUT "\n"; print OUT "/***********************************************************************\n"; print OUT " * Test macros\n"; print OUT " */\n"; print OUT "\n"; print OUT "#define TEST_FIELD(type, field_type, field_name, field_offset, field_size, field_align) \\\n"; print OUT " TEST_TYPE_SIZE(field_type, field_size); \\\n"; print OUT " TEST_FIELD_ALIGNMENT(type, field_name, field_align); \\\n"; print OUT " TEST_FIELD_OFFSET(type, field_name, field_offset); \\\n"; print OUT "\n"; print OUT "#define TEST_TYPE(type, size, align) \\\n"; print OUT " TEST_TYPE_ALIGNMENT(type, align); \\\n"; print OUT " TEST_TYPE_SIZE(type, size)\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_type sub output_test_pack_type { local *OUT = shift; my $types = shift; my $type_name = shift; my $type = shift; my $type_align = $type->align; my $type_pack = $type->pack; my $type_size = $type->size; print OUT " /* $type_name (pack $type_pack) */\n"; if (defined($type_align) && defined($type_size)) { print OUT " TEST_TYPE($type_name, $type_size, $type_align);\n"; } } sub output_test_pack_fields { local *OUT = shift; my $types = shift; my $type_name = shift; my $type = shift; my $offset = shift; my $optional_field = shift; foreach my $field ($type->fields()) { 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 ($$optional_field{$field_name}) { # Nothing } elsif (defined($field_size) && defined($field_offset)) { $field_offset += $offset; if ($field_name eq "DUMMYSTRUCTNAME") { print OUT "#ifdef NONAMELESSSTRUCT\n"; print OUT " TEST_FIELD($type_name, $field_type_name, $field_name, "; print OUT "$field_offset, $field_size, $field_align);\n"; print OUT "#else\n"; output_test_pack_fields(\*OUT, $types, $type_name, $$types{$field_type_name}, $field_offset, $optional_field); print OUT "#endif\n"; } else { print OUT " TEST_FIELD($type_name, $field_type_name, $field_name, "; print OUT "$field_offset, $field_size, $field_align);\n"; } } else { $output->write("$type_name: $field_type_name: $field_name: test not generated (offset not defined)\n"); } } } ######################################################################## # output_test_pack sub output_test_pack { local *OUT = shift; my $test_dir = shift; my $test = shift; my @headers = $tests->get_section($test_dir, $test, "header"); my @type_names = $tests->get_section($test_dir, $test, "struct"); my %type_name_not_used; foreach my $_type_name (@type_names) { my $type_name = $_type_name; $type_name =~ s/:.*?$//; $type_name_not_used{$type_name} = 1; } foreach my $header (@headers) { my $types = $file2types{"include/$header"}; foreach my $_type_name (@type_names) { my $type_name = $_type_name; my %optional_field = (); if ($type_name =~ s/:\s*(.*?)$//) { my @fields = split /\s+/, $1; foreach my $field (@fields) { if ($field =~ s/^!//) { $optional_field{$field}++; } } } my $type = $$types{$type_name}; if (!defined($type)) { next; } $type_name_not_used{$type_name} = 0; if (!scalar(keys(%optional_field))) { output_test_pack_type(\*OUT, $types, $type_name, $type); } else { print OUT " /* $type_name */\n"; } output_test_pack_fields(\*OUT, $types, $type_name, $type, 0, \%optional_field); print OUT "\n"; } } foreach my $_type_name (@type_names) { my $type_name = $_type_name; $type_name =~ s/:.*?$//; 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); return 1; } ######################################################################## # 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); }