ReceiveTempSMS
/
Sweden-Number
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

- Added a new tool winapi_test for generating tests. 

- Added a data structure packing test to winapi_test.
- Reorganized and optimized a few things.
This commit is contained in:
Patrik Stridvall 2002-10-01 18:10:54 +00:00 committed by Alexandre Julliard
parent e29345c3bb
commit a40a4f719e
12 changed files with 759 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tools/winapi/Makefile.in
View File

@ -14,11 +14,13 @@ install::
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_cleanup
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_extract
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_fixup
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_test
uninstall::
$(RM) $(bindir)/make_filter
$(RM) $(bindir)/winapi_check
$(RM) $(bindir)/winapi_extract
$(RM) $(bindir)/winapi_fixup
$(RM) $(bindir)/winapi_test
### Dependencies:

116
tools/winapi/c_parser.pm
View File

@ -776,6 +776,7 @@ sub parse_c_file {
my $previous_line = 0;
my $previous_column = -1;
my $preprocessor_condition;
my $if = 0;
my $if0 = 0;
my $extern_c = 0;
@ -902,19 +903,40 @@ sub parse_c_file {
$preprocessor .= $1;
}
if($if0 && $preprocessor =~ /^\#\s*endif/) {
if (0) {
# Nothing
} elsif($preprocessor =~ /^\#\s*if/) {
if($preprocessor =~ /^\#\s*if\s*0/) {
$if0++;
} elsif($if0 > 0) {
$if++;
} else {
if($preprocessor =~ /^\#\s*ifdef\s+WORDS_BIGENDIAN$/) {
$preprocessor_condition = "defined(WORD_BIGENDIAN)";
# $output->write("'$preprocessor_condition':'$declaration'\n")
} else {
$preprocessor_condition = "";
}
}
} elsif($preprocessor =~ /^\#\s*else/) {
if ($preprocessor_condition ne "") {
$preprocessor_condition =~ "!$preprocessor_condition";
$preprocessor_condition =~ s/^!!/!/;
# $output->write("'$preprocessor_condition':'$declaration'\n")
}
} elsif($preprocessor =~ /^\#\s*endif/) {
if($if0 > 0) {
if($if > 0) {
$if--;
} else {
$if0--;
}
}
} elsif($preprocessor =~ /^\#\s*if/) {
if($preprocessor =~ /^\#\s*if\s*0/) {
$if0++;
} elsif($if0 > 0) {
$if++;
} else {
if ($preprocessor_condition ne "") {
# $output->write("'$preprocessor_condition':'$declaration'\n");
$preprocessor_condition = "";
}
}
}
@ -1606,6 +1628,7 @@ sub parse_c_typedef {
my $create_type = \${$self->{CREATE_TYPE}};
my $found_type = \${$self->{FOUND_TYPE}};
my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
my $refcurrent = shift;
my $refline = shift;
@ -1639,14 +1662,16 @@ sub parse_c_typedef {
{
my $field_linkage;
my $field_type;
my $field_name;
my $field_name;
if ($self->parse_c_variable(\$match, \$line, \$column, \$field_linkage, \$field_type, \$field_name)) {
$field_type =~ s/\s+/ /g;
push @field_types, $field_type;
push @field_names, $field_name;
# $output->write("$kind:$_name:$field_type:$field_name\n");
} elsif ($match) {
$self->_parse_c_error($_, $line, $column, "typedef $kind: '$match'");
}
if ($self->_parse_c(';', \$_, \$line, \$column)) {
@ -1799,12 +1824,43 @@ sub parse_c_variable {
if($finished) {
# Nothing
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+\s*(?:\*\s*)*)(\w+)$//s) {
$type = $self->_format_c_type($1);
} elsif(s/^(enum|struct|union)(?:\s+(\w+))?\s*\{//s) {
my $kind = $1;
my $_name = $2;
$self->_update_c_position($&, \$line, \$column);
if(defined($_name)) {
$type = "$kind $_name { }";
} else {
$type = "$kind { }";
}
$finished = 1;
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+(?:\s*\*)*)\s*(\w+)\s*(\[.*?\]$|:\s*(\d+)$|\{)?//s) {
$type = $1;
$name = $2;
if (defined($3)) {
my $bits = $4;
local $_ = $3;
if (/^\[/) {
$type .= $_;
} elsif (/^:/) {
$type .= ":$bits";
} elsif (/^\{/) {
# Nothing
}
}
$type = $self->_format_c_type($type);
$finished = 1;
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+(?:\s*\*)*\s*\(\s*(?:\*\s*)*)(\w+)\s*(\)\(.*?\))$//s) {
$type = $self->_format_c_type("$1$3");
$name = $2;
$finished = 1;
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+\s*(?:\*\s*)*\(\s*(?:\*\s*)*)(\w+)\s*(\)\(.*?\))$//s) {
$type = $self->_format_c_type("$1$3");
$name = $2;
@ -1827,21 +1883,16 @@ sub parse_c_variable {
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
$type = $match;
$finished = 1;
} elsif(s/^(?:enum\s+|struct\s+|union\s+)(\w+)?\s*\{.*?\}\s*//s) {
} elsif(s/^(enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*//s) {
my $kind = $1;
my $_name = $2;
$self->_update_c_position($&, \$line, \$column);
if(defined($1)) {
$type = "struct $1 { }";
if(defined($_name)) {
$type = "struct $_name { }";
} else {
$type = "struct { }";
}
if(defined($2)) {
my $stars = $2;
$stars =~ s/\s//g;
if($stars) {
$type .= " $type";
}
}
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
$type = $&;
$type =~ s/\s//g;
@ -1889,7 +1940,7 @@ sub parse_c_variable {
# $output->write("$type: $name: '$_'\n");
if(1) {
if(1 || $finished) {
# Nothing
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
$type = "<type>";
@ -1906,29 +1957,28 @@ sub parse_c_variable {
$type =~ s/\s//g;
$type =~ s/^struct/struct /;
} elsif(/^(?:enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*((?:\*\s*)*)(\w+)\s*(?:=|$)/s) {
} elsif(/^(enum|struct|union)(?:\s+(\w+))?\s*\{.*?\}\s*((?:\*\s*)*)(\w+)\s*(?:=|$)/s) {
$self->_update_c_position($&, \$line, \$column);
if(defined($1)) {
$type = "struct $1 { }";
my $kind = $1;
my $_name= $2;
my $stars = $3;
$name = $4;
if(defined($_name)) {
$type = "struct $_name { }";
} else {
$type = "struct { }";
}
my $stars = $2;
$stars =~ s/\s//g;
if($stars) {
$type .= " $type";
}
$name = $3;
} else {
return 0;
}
if(!$name) {
$name = "<name>";
}
$$refcurrent = $_;
$$refline = $line;
$$refcolumn = $column;

30
tools/winapi/c_type.pm
View File

@ -59,7 +59,14 @@ sub name {
if(defined($_)) { $$name = $_; }
return $$name;
if($$name) {
return $$name;
} else {
my $kind = \${$self->{KIND}};
my $_name = \${$self->{_NAME}};
return "$$kind $$_name";
}
}
sub fields {
@ -77,6 +84,16 @@ sub fields {
return @fields;
}
sub field_names {
my $self = shift;
my $field_names = \${$self->{FIELD_NAMES}};
local $_ = shift;
if(defined($_)) { $$field_names = $_; }
return $$field_names;
}
sub field_types {
my $self = shift;
@ -89,15 +106,4 @@ sub field_types {
return $$field_types;
}
sub field_names {
my $self = shift;
my $field_names = \${$self->{FIELD_NAMES}};
local $_ = shift;
if(defined($_)) { $$field_names = $_; }
return $$field_names;
}
1;

54
tools/winapi/tests.dat Normal file
View File

@ -0,0 +1,54 @@
%%%dlls/kernel/tests
%%pack
%description
Unit tests for data structure packing
%include
winbase.h
%struct
BY_HANDLE_FILE_INFORMATION
COMMCONFIG
COMMPROP
COMMTIMEOUTS
COMSTAT
CREATE_PROCESS_DEBUG_INFO
CREATE_THREAD_DEBUG_INFO
DCB
# DEBUG_EVENT
EXCEPTION_DEBUG_INFO
EXIT_PROCESS_DEBUG_INFO
EXIT_THREAD_DEBUG_INFO
# FILETIME
# HW_PROFILE_INFOA
LDT_ENTRY
LOAD_DLL_DEBUG_INFO
MEMORYSTATUS
# OFSTRUCT
OSVERSIONINFOA
OSVERSIONINFOEXA
OSVERSIONINFOEXW
OSVERSIONINFOW
OUTPUT_DEBUG_STRING_INFO
OVERLAPPED
# PROCESS_HEAP_ENTRY
PROCESS_INFORMATION
RIP_INFO
SECURITY_ATTRIBUTES
STARTUPINFOA
STARTUPINFOW
SYSLEVEL
SYSTEMTIME
SYSTEM_INFO
SYSTEM_POWER_STATUS
TIME_ZONE_INFORMATION
UNLOAD_DLL_DEBUG_INFO
WIN32_FILE_ATTRIBUTE_DATA
WIN32_FIND_DATAA
WIN32_FIND_DATAW
WIN32_STREAM_ID

150
tools/winapi/tests.pm Normal file
View File

@ -0,0 +1,150 @@
#
# 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
#
package tests;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($tests);
use vars qw($tests);
use config qw($current_dir $wine_dir $winapi_dir);
use options qw($options);
use output qw($output);
sub import {
$Exporter::ExportLevel++;
&Exporter::import(@_);
$Exporter::ExportLevel--;
$tests = 'tests'->new;
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
$self->parse_tests_file();
return $self;
}
sub parse_tests_file {
my $self = shift;
my $file = "tests.dat";
my $tests = \%{$self->{TESTS}};
$output->lazy_progress($file);
my $test_dir;
my $test;
my $section;
open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
while(<IN>) {
s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
s/^(.*?)\s*#.*$/$1/; # remove comments
/^$/ && next; # skip empty lines
if (/^%%%\s*(\S+)$/) {
$test_dir = $1;
} elsif (/^%%\s*(\w+)$/) {
$test = $1;
} elsif (/^%\s*(\w+)$/) {
$section = $1;
} elsif (!/^%/) {
if (!exists($$tests{$test_dir}{$test}{$section})) {
$$tests{$test_dir}{$test}{$section} = [];
}
push @{$$tests{$test_dir}{$test}{$section}}, $_;
} else {
$output->write("$file:$.: parse error: '$_'\n");
exit 1;
}
}
close(IN);
}
sub get_tests {
my $self = shift;
my $tests = \%{$self->{TESTS}};
my $test_dir = shift;
my %tests = ();
if (defined($test_dir)) {
foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
$tests{$test}++;
}
} else {
foreach my $test_dir (sort(keys(%$tests))) {
foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
$tests{$test}++;
}
}
}
return sort(keys(%tests));
}
sub get_test_dirs {
my $self = shift;
my $tests = \%{$self->{TESTS}};
my $test = shift;
my %test_dirs = ();
if (defined($test)) {
foreach my $test_dir (sort(keys(%$tests))) {
if (exists($$tests{$test_dir}{$test})) {
$test_dirs{$test_dir}++;
}
}
} else {
foreach my $test_dir (sort(keys(%$tests))) {
$test_dirs{$test_dir}++;
}
}
return sort(keys(%test_dirs));
}
sub get_section {
my $self = shift;
my $tests = \%{$self->{TESTS}};
my $test_dir = shift;
my $test = shift;
my $section = shift;
return @{$$tests{$test_dir}{$test}{$section}};
}
1;

41
tools/winapi/winapi.pm
View File

@ -30,30 +30,41 @@ require Exporter;
use vars qw($win16api $win32api @winapis);
use config qw($current_dir $wine_dir $winapi_dir);
use modules qw($modules);
use options qw($options);
use output qw($output);
my @spec_files16 = $modules->allowed_spec_files16;
$win16api = 'winapi'->new("win16", \@spec_files16);
use vars qw($modules);
my @spec_files32 = $modules->allowed_spec_files32;
$win32api = 'winapi'->new("win32", \@spec_files32);
sub import {
$Exporter::ExportLevel++;
&Exporter::import(@_);
$Exporter::ExportLevel--;
@winapis = ($win16api, $win32api);
require modules;
import modules qw($modules);
for my $internal_name ($win32api->all_internal_functions) {
my $module16 = $win16api->function_internal_module($internal_name);
my $module32 = $win16api->function_internal_module($internal_name);
if(defined($module16) &&
!$win16api->is_function_stub_in_module($module16, $internal_name) &&
!$win32api->is_function_stub_in_module($module32, $internal_name))
{
$win16api->found_shared_internal_function($internal_name);
$win32api->found_shared_internal_function($internal_name);
my @spec_files16 = $modules->allowed_spec_files16;
$win16api = 'winapi'->new("win16", \@spec_files16);
my @spec_files32 = $modules->allowed_spec_files32;
$win32api = 'winapi'->new("win32", \@spec_files32);
@winapis = ($win16api, $win32api);
for my $internal_name ($win32api->all_internal_functions) {
my $module16 = $win16api->function_internal_module($internal_name);
my $module32 = $win16api->function_internal_module($internal_name);
if(defined($module16) &&
!$win16api->is_function_stub_in_module($module16, $internal_name) &&
!$win32api->is_function_stub_in_module($module32, $internal_name))
{
$win16api->found_shared_internal_function($internal_name);
$win32api->found_shared_internal_function($internal_name);
}
}
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;

27
tools/winapi/winapi_cleanup
View File

@ -28,37 +28,14 @@ use config qw($current_dir $wine_dir);
use output qw($output);
use winapi_cleanup_options qw($options);
use util qw(edit_file);
if($options->progress) {
$output->enable_progress;
} else {
$output->disable_progress;
}
########################################################################
# edit_file
sub edit_file {
my $filename = shift;
my $function = shift;
open(IN, "< $filename") || die "Can't open file '$filename'";
open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
my $result = &$function(\*IN, \*OUT, @_);
close(IN);
close(OUT);
if($result) {
unlink($filename);
rename("$filename.tmp", $filename);
} else {
unlink("$filename.tmp");
}
return $result;
}
########################################################################
# cleanup_file

26
tools/winapi/winapi_extract
View File

@ -41,10 +41,15 @@ use c_parser;
use function;
use type;
use winapi qw($win16api $win32api @winapis);
use winapi_c_parser;
use winapi_function;
use vars qw($win16api $win32api @winapis);
if ($options->spec_files || $options->winetest) {
require winapi;
import winapi qw($win16api $win32api @winapis);
}
my %module2entries;
my %module2spec_file;
if($options->spec_files || $options->winetest) {
@ -257,7 +262,9 @@ foreach my $file (@h_files, @c_files) {
my $name = $function->name;
$functions{$name} = $function;
&$update_output();
if ($function->statements) {
&$update_output();
}
my $old_function;
if($options->stub_statistics) {
@ -295,11 +302,22 @@ foreach my $file (@h_files, @c_files) {
statements_stub($old_function);
}
$function = undef;
&$update_output();
if ($function->statements) {
$function = undef;
&$update_output();
} else {
$function = undef;
}
};
$parser->set_found_function_callback($found_function);
my $found_line = sub {
$line = shift;
&$update_output;
};
$parser->set_found_line_callback($found_line);
my $found_type = sub {
my $type = shift;

304
tools/winapi/winapi_test Executable file
View File

@ -0,0 +1,304 @@
#!/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"}++;
}
}
}
@files = sort(keys(%files));
}
my %file2types;
my $progress_output;
my $progress_current = 0;
my $progress_max = scalar(@files);
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 $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_type = sub {
$type = shift;
my $name = $type->name;
$file2types{$file}{$name} = $type;
&$update_output();
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("");
}
sub output_header {
local *OUT = shift;
my $test_dir = shift;
my $test = shift;
print OUT "/* File generated automatically from $wine_dir/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";
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";
my @includes = $tests->get_section($test_dir, $test, "include");
foreach my $include (@includes) {
print OUT "#include \"$include\"\n";
}
print OUT "\n";
print OUT "START_TEST(generated_$test)\n";
print OUT "{\n";
}
sub output_footer {
local *OUT = shift;
my $test_dir = shift;
my $test = shift;
print OUT "}\n";
}
sub field_size {
my $name = shift;
my $field_type = shift;
my $field_name = shift;
local $_ = $field_type;
my $count;
my $bits;
if (s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/) {
$count = $2;
$bits = $3;
}
my $size;
if(/^(?:(?:signed\s+|unsigned\s+)?char|CHAR|BYTE|UCHAR)$/) {
$size = 1;
} elsif (/^(?:(?:signed\s+|unsigned\s+)?short|UWORD|WCHAR|WORD)$/) {
$size = 2;
} elsif (/^(?:FILETIME|LARGE_INTEGER|LONGLONG|ULONGLONG)$/) {
$size = 8;
} elsif (/^(?:SYSTEMTIME)$/) {
$size = 16;
} elsif (/^(?:CRITICAL_SECTION)$/) {
$size = 24;
} elsif (/^(?:DCB)$/) {
$size = 28;
} elsif (/^(?:EXCEPTION_RECORD)$/) {
$size = 80;
} elsif (/^(?:struct|union)$/) {
$output->write("$name:$field_name: can't parse type '$field_type'\n");
$size = 4;
} else {
$size = 4;
}
if (defined($count)) {
if ($count =~ /^\d+$/) {
return $size * int($count);
} elsif ($count =~ /^ANYSIZE_ARRAY$/) {
return $size;
} else {
$output->write("$name:$field_name: can't parse type '$field_type'\n");
return $size; # Not correct.
}
} elsif (defined($bits)) {
return -$bits;
} else {
return $size;
}
}
########################################################################
# output_file
sub output_file {
local *OUT = shift;
my $test_dir = shift;
my $test = shift;
output_header(\*OUT, $test_dir, $test);
my @includes = $tests->get_section($test_dir, $test, "include");
my @type_names = $tests->get_section($test_dir, $test, "struct");
foreach my $include (@includes) {
my $types = $file2types{"include/$include"};
foreach my $type_name (@type_names) {
my $pack = 4; # FIXME: Not always correct
my $type = $$types{$type_name};
my $offset = 0;
my $offset_bits = 0;
print OUT " /* $type_name */\n";
foreach my $field ($type->fields) {
(my $field_type, my $field_name) = @$field;
my $field_size = field_size($type_name, $field_type, $field_name);
if ($field_size >= 0) {
if ($offset_bits) {
$offset += $pack * int(($offset_bits + 8 * $pack - 1 ) / (8 * $pack));
$offset_bits = 0;
}
my $field_offset = $offset;
if ($field_name ne "") {
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 */\n";
}
$offset += $field_size;
} else {
$offset_bits += -$field_size;
}
}
my $type_size = $offset;
if ($type_size % $pack != 0) {
$type_size = (int($type_size / $pack) + 1) * $pack;
}
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";
}
}
output_footer(\*OUT, $test_dir, $test);
}
foreach my $test (@tests) {
my @test_dirs = $tests->get_test_dirs($test);
foreach my $test_dir (@test_dirs) {
my $file = "$wine_dir/$test_dir/generated_$test.c";
replace_file($file, \&output_file, $test_dir, $test);
}
}

53
tools/winapi/winapi_test_options.pm Normal file
View File

@ -0,0 +1,53 @@
#
# 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
#
package winapi_test_options;
use base qw(options);
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($options);
use options qw($options &parse_comma_list);
my %options_long = (
"debug" => { default => 0, description => "debug mode" },
"help" => { default => 0, description => "help mode" },
"verbose" => { default => 0, description => "verbose mode" },
"progress" => { default => 1, description => "show progress" },
"pack" => { default => 1, description => "generate data structures packing tests" },
);
my %options_short = (
"d" => "debug",
"?" => "help",
"v" => "verbose"
);
my $options_usage = "usage: winapi_test [--help]\n";
$options = '_options'->new(\%options_long, \%options_short, $options_usage);
1;

45
tools/winapi_check/modules.pm
View File

@ -39,7 +39,13 @@ use config qw(
use options qw($options);
use output qw($output);
$modules = 'modules'->new;
sub import {
$Exporter::ExportLevel++;
&Exporter::import(@_);
$Exporter::ExportLevel--;
$modules = 'modules'->new;
}
sub get_spec_file_type {
my $file = shift;
@ -85,18 +91,23 @@ sub new {
my $self = {};
bless ($self, $class);
my $spec_files16 = \@{$self->{SPEC_FILES16}};
my $spec_files32 = \@{$self->{SPEC_FILES32}};
my $spec_file_found = $self->read_module_file();
$self->read_spec_files($spec_file_found);
return $self;
}
sub read_module_file {
my $self = shift;
my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
my $module_file = "$winapi_check_dir/modules.dat";
$output->progress("modules.dat");
my %spec_file_found;
my $spec_file_found = {};
my $allowed_dir;
my $spec_file;
@ -114,7 +125,7 @@ sub new {
$output->write("modules.dat: $spec_file: file ($spec_file) doesn't exist or is no file\n");
}
$spec_file_found{$spec_file}++;
$$spec_file_found{$spec_file}++;
$$spec_file2dir{$spec_file} = {};
next;
} else {
@ -129,6 +140,20 @@ sub new {
}
close(IN);
return $spec_file_found;
}
sub read_spec_files {
my $self = shift;
my $spec_file_found = shift;
my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
my $spec_files16 = \@{$self->{SPEC_FILES16}};
my $spec_files32 = \@{$self->{SPEC_FILES32}};
my $spec_file2module = \%{$self->{SPEC_FILE2MODULE}};
my $module2spec_file = \%{$self->{MODULE2SPEC_FILE}};
my @spec_files;
if($wine_dir eq ".") {
@spec_files = get_spec_files("winelib");
@ -162,14 +187,10 @@ sub new {
}
foreach my $spec_file (@spec_files) {
if(!$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) {
if(!$$spec_file_found{$spec_file} && $spec_file !~ m%tests/[^/]+$%) {
$output->write("modules.dat: $spec_file: exists but is not specified\n");
}
}
$modules = $self;
return $self;
}
sub all_modules {

14
tools/winapi_check/winapi_function.pm
View File

@ -22,9 +22,10 @@ use base qw(function);
use strict;
use config qw($current_dir $wine_dir);
use modules qw($modules);
use util qw(&normalize_set);
use winapi qw($win16api $win32api @winapis);
my $import = 0;
use vars qw($modules $win16api $win32api @winapis);
########################################################################
# constructor
@ -36,6 +37,15 @@ sub new {
my $self = {};
bless ($self, $class);
if (!$import) {
require modules;
import modules qw($modules);
require winapi;
import winapi qw($win16api $win32api @winapis);
$import = 1;
}
return $self;
}