mirror of
git://source.winehq.org/git/wine.git
synced 2024-10-04 20:27:43 +00:00
- 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:
parent
e29345c3bb
commit
a40a4f719e
|
@ -14,11 +14,13 @@ install::
|
||||||
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_cleanup
|
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_cleanup
|
||||||
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_extract
|
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_extract
|
||||||
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_fixup
|
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_fixup
|
||||||
|
$(INSTALL_SCRIPT) $(SRCDIR)/trampoline $(bindir)/winapi_test
|
||||||
|
|
||||||
uninstall::
|
uninstall::
|
||||||
$(RM) $(bindir)/make_filter
|
$(RM) $(bindir)/make_filter
|
||||||
$(RM) $(bindir)/winapi_check
|
$(RM) $(bindir)/winapi_check
|
||||||
$(RM) $(bindir)/winapi_extract
|
$(RM) $(bindir)/winapi_extract
|
||||||
$(RM) $(bindir)/winapi_fixup
|
$(RM) $(bindir)/winapi_fixup
|
||||||
|
$(RM) $(bindir)/winapi_test
|
||||||
|
|
||||||
### Dependencies:
|
### Dependencies:
|
||||||
|
|
|
@ -776,6 +776,7 @@ sub parse_c_file {
|
||||||
my $previous_line = 0;
|
my $previous_line = 0;
|
||||||
my $previous_column = -1;
|
my $previous_column = -1;
|
||||||
|
|
||||||
|
my $preprocessor_condition;
|
||||||
my $if = 0;
|
my $if = 0;
|
||||||
my $if0 = 0;
|
my $if0 = 0;
|
||||||
my $extern_c = 0;
|
my $extern_c = 0;
|
||||||
|
@ -902,19 +903,40 @@ sub parse_c_file {
|
||||||
$preprocessor .= $1;
|
$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($if0 > 0) {
|
||||||
if($if > 0) {
|
if($if > 0) {
|
||||||
$if--;
|
$if--;
|
||||||
} else {
|
} else {
|
||||||
$if0--;
|
$if0--;
|
||||||
}
|
}
|
||||||
}
|
} else {
|
||||||
} elsif($preprocessor =~ /^\#\s*if/) {
|
if ($preprocessor_condition ne "") {
|
||||||
if($preprocessor =~ /^\#\s*if\s*0/) {
|
# $output->write("'$preprocessor_condition':'$declaration'\n");
|
||||||
$if0++;
|
$preprocessor_condition = "";
|
||||||
} elsif($if0 > 0) {
|
}
|
||||||
$if++;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1606,6 +1628,7 @@ sub parse_c_typedef {
|
||||||
|
|
||||||
my $create_type = \${$self->{CREATE_TYPE}};
|
my $create_type = \${$self->{CREATE_TYPE}};
|
||||||
my $found_type = \${$self->{FOUND_TYPE}};
|
my $found_type = \${$self->{FOUND_TYPE}};
|
||||||
|
my $preprocessor_condition = \${$self->{PREPROCESSOR_CONDITION}};
|
||||||
|
|
||||||
my $refcurrent = shift;
|
my $refcurrent = shift;
|
||||||
my $refline = shift;
|
my $refline = shift;
|
||||||
|
@ -1647,6 +1670,8 @@ sub parse_c_typedef {
|
||||||
push @field_types, $field_type;
|
push @field_types, $field_type;
|
||||||
push @field_names, $field_name;
|
push @field_names, $field_name;
|
||||||
# $output->write("$kind:$_name:$field_type:$field_name\n");
|
# $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)) {
|
if ($self->_parse_c(';', \$_, \$line, \$column)) {
|
||||||
|
@ -1799,12 +1824,43 @@ sub parse_c_variable {
|
||||||
|
|
||||||
if($finished) {
|
if($finished) {
|
||||||
# Nothing
|
# Nothing
|
||||||
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+\s*(?:\*\s*)*)(\w+)$//s) {
|
} elsif(s/^(enum|struct|union)(?:\s+(\w+))?\s*\{//s) {
|
||||||
$type = $self->_format_c_type($1);
|
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;
|
$name = $2;
|
||||||
|
|
||||||
$finished = 1;
|
$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");
|
$type = $self->_format_c_type("$1$3");
|
||||||
$name = $2;
|
$name = $2;
|
||||||
|
|
||||||
|
@ -1827,21 +1883,16 @@ sub parse_c_variable {
|
||||||
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
|
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(\w+\)', \$_, \$line, \$column, \$match)) {
|
||||||
$type = $match;
|
$type = $match;
|
||||||
$finished = 1;
|
$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);
|
$self->_update_c_position($&, \$line, \$column);
|
||||||
|
|
||||||
if(defined($1)) {
|
if(defined($_name)) {
|
||||||
$type = "struct $1 { }";
|
$type = "struct $_name { }";
|
||||||
} else {
|
} else {
|
||||||
$type = "struct { }";
|
$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) {
|
} elsif(s/^((?:enum\s+|struct\s+|union\s+)?\w+)\s*(?:\*\s*)*//s) {
|
||||||
$type = $&;
|
$type = $&;
|
||||||
$type =~ s/\s//g;
|
$type =~ s/\s//g;
|
||||||
|
@ -1889,7 +1940,7 @@ sub parse_c_variable {
|
||||||
|
|
||||||
# $output->write("$type: $name: '$_'\n");
|
# $output->write("$type: $name: '$_'\n");
|
||||||
|
|
||||||
if(1) {
|
if(1 || $finished) {
|
||||||
# Nothing
|
# Nothing
|
||||||
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
|
} elsif($self->_parse_c('(?:struct\s+)?ICOM_VTABLE\s*\(.*?\)', \$_, \$line, \$column, \$match)) {
|
||||||
$type = "<type>";
|
$type = "<type>";
|
||||||
|
@ -1906,29 +1957,28 @@ sub parse_c_variable {
|
||||||
|
|
||||||
$type =~ s/\s//g;
|
$type =~ s/\s//g;
|
||||||
$type =~ s/^struct/struct /;
|
$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);
|
$self->_update_c_position($&, \$line, \$column);
|
||||||
|
|
||||||
if(defined($1)) {
|
my $kind = $1;
|
||||||
$type = "struct $1 { }";
|
my $_name= $2;
|
||||||
|
my $stars = $3;
|
||||||
|
$name = $4;
|
||||||
|
|
||||||
|
if(defined($_name)) {
|
||||||
|
$type = "struct $_name { }";
|
||||||
} else {
|
} else {
|
||||||
$type = "struct { }";
|
$type = "struct { }";
|
||||||
}
|
}
|
||||||
my $stars = $2;
|
|
||||||
$stars =~ s/\s//g;
|
$stars =~ s/\s//g;
|
||||||
if($stars) {
|
if($stars) {
|
||||||
$type .= " $type";
|
$type .= " $type";
|
||||||
}
|
}
|
||||||
|
|
||||||
$name = $3;
|
|
||||||
} else {
|
} else {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
if(!$name) {
|
|
||||||
$name = "<name>";
|
|
||||||
}
|
|
||||||
|
|
||||||
$$refcurrent = $_;
|
$$refcurrent = $_;
|
||||||
$$refline = $line;
|
$$refline = $line;
|
||||||
$$refcolumn = $column;
|
$$refcolumn = $column;
|
||||||
|
|
|
@ -59,7 +59,14 @@ sub name {
|
||||||
|
|
||||||
if(defined($_)) { $$name = $_; }
|
if(defined($_)) { $$name = $_; }
|
||||||
|
|
||||||
return $$name;
|
if($$name) {
|
||||||
|
return $$name;
|
||||||
|
} else {
|
||||||
|
my $kind = \${$self->{KIND}};
|
||||||
|
my $_name = \${$self->{_NAME}};
|
||||||
|
|
||||||
|
return "$$kind $$_name";
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub fields {
|
sub fields {
|
||||||
|
@ -77,6 +84,16 @@ sub fields {
|
||||||
return @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 {
|
sub field_types {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
@ -89,15 +106,4 @@ sub field_types {
|
||||||
return $$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;
|
1;
|
||||||
|
|
54
tools/winapi/tests.dat
Normal file
54
tools/winapi/tests.dat
Normal 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
150
tools/winapi/tests.pm
Normal 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;
|
|
@ -30,30 +30,41 @@ require Exporter;
|
||||||
use vars qw($win16api $win32api @winapis);
|
use vars qw($win16api $win32api @winapis);
|
||||||
|
|
||||||
use config qw($current_dir $wine_dir $winapi_dir);
|
use config qw($current_dir $wine_dir $winapi_dir);
|
||||||
use modules qw($modules);
|
|
||||||
use options qw($options);
|
use options qw($options);
|
||||||
use output qw($output);
|
use output qw($output);
|
||||||
|
|
||||||
my @spec_files16 = $modules->allowed_spec_files16;
|
use vars qw($modules);
|
||||||
$win16api = 'winapi'->new("win16", \@spec_files16);
|
|
||||||
|
|
||||||
my @spec_files32 = $modules->allowed_spec_files32;
|
sub import {
|
||||||
$win32api = 'winapi'->new("win32", \@spec_files32);
|
$Exporter::ExportLevel++;
|
||||||
|
&Exporter::import(@_);
|
||||||
|
$Exporter::ExportLevel--;
|
||||||
|
|
||||||
@winapis = ($win16api, $win32api);
|
require modules;
|
||||||
|
import modules qw($modules);
|
||||||
|
|
||||||
for my $internal_name ($win32api->all_internal_functions) {
|
my @spec_files16 = $modules->allowed_spec_files16;
|
||||||
my $module16 = $win16api->function_internal_module($internal_name);
|
$win16api = 'winapi'->new("win16", \@spec_files16);
|
||||||
my $module32 = $win16api->function_internal_module($internal_name);
|
|
||||||
if(defined($module16) &&
|
my @spec_files32 = $modules->allowed_spec_files32;
|
||||||
!$win16api->is_function_stub_in_module($module16, $internal_name) &&
|
$win32api = 'winapi'->new("win32", \@spec_files32);
|
||||||
!$win32api->is_function_stub_in_module($module32, $internal_name))
|
|
||||||
{
|
@winapis = ($win16api, $win32api);
|
||||||
$win16api->found_shared_internal_function($internal_name);
|
|
||||||
$win32api->found_shared_internal_function($internal_name);
|
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 {
|
sub new {
|
||||||
my $proto = shift;
|
my $proto = shift;
|
||||||
my $class = ref($proto) || $proto;
|
my $class = ref($proto) || $proto;
|
||||||
|
|
|
@ -28,37 +28,14 @@ use config qw($current_dir $wine_dir);
|
||||||
use output qw($output);
|
use output qw($output);
|
||||||
use winapi_cleanup_options qw($options);
|
use winapi_cleanup_options qw($options);
|
||||||
|
|
||||||
|
use util qw(edit_file);
|
||||||
|
|
||||||
if($options->progress) {
|
if($options->progress) {
|
||||||
$output->enable_progress;
|
$output->enable_progress;
|
||||||
} else {
|
} else {
|
||||||
$output->disable_progress;
|
$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
|
# cleanup_file
|
||||||
|
|
||||||
|
|
|
@ -41,10 +41,15 @@ use c_parser;
|
||||||
use function;
|
use function;
|
||||||
use type;
|
use type;
|
||||||
|
|
||||||
use winapi qw($win16api $win32api @winapis);
|
|
||||||
use winapi_c_parser;
|
use winapi_c_parser;
|
||||||
use winapi_function;
|
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 %module2entries;
|
||||||
my %module2spec_file;
|
my %module2spec_file;
|
||||||
if($options->spec_files || $options->winetest) {
|
if($options->spec_files || $options->winetest) {
|
||||||
|
@ -257,7 +262,9 @@ foreach my $file (@h_files, @c_files) {
|
||||||
my $name = $function->name;
|
my $name = $function->name;
|
||||||
$functions{$name} = $function;
|
$functions{$name} = $function;
|
||||||
|
|
||||||
&$update_output();
|
if ($function->statements) {
|
||||||
|
&$update_output();
|
||||||
|
}
|
||||||
|
|
||||||
my $old_function;
|
my $old_function;
|
||||||
if($options->stub_statistics) {
|
if($options->stub_statistics) {
|
||||||
|
@ -295,11 +302,22 @@ foreach my $file (@h_files, @c_files) {
|
||||||
statements_stub($old_function);
|
statements_stub($old_function);
|
||||||
}
|
}
|
||||||
|
|
||||||
$function = undef;
|
if ($function->statements) {
|
||||||
&$update_output();
|
$function = undef;
|
||||||
|
&$update_output();
|
||||||
|
} else {
|
||||||
|
$function = undef;
|
||||||
|
}
|
||||||
};
|
};
|
||||||
$parser->set_found_function_callback($found_function);
|
$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 $found_type = sub {
|
||||||
my $type = shift;
|
my $type = shift;
|
||||||
|
|
||||||
|
|
304
tools/winapi/winapi_test
Executable file
304
tools/winapi/winapi_test
Executable 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
53
tools/winapi/winapi_test_options.pm
Normal 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;
|
|
@ -39,7 +39,13 @@ use config qw(
|
||||||
use options qw($options);
|
use options qw($options);
|
||||||
use output qw($output);
|
use output qw($output);
|
||||||
|
|
||||||
$modules = 'modules'->new;
|
sub import {
|
||||||
|
$Exporter::ExportLevel++;
|
||||||
|
&Exporter::import(@_);
|
||||||
|
$Exporter::ExportLevel--;
|
||||||
|
|
||||||
|
$modules = 'modules'->new;
|
||||||
|
}
|
||||||
|
|
||||||
sub get_spec_file_type {
|
sub get_spec_file_type {
|
||||||
my $file = shift;
|
my $file = shift;
|
||||||
|
@ -85,18 +91,23 @@ sub new {
|
||||||
my $self = {};
|
my $self = {};
|
||||||
bless ($self, $class);
|
bless ($self, $class);
|
||||||
|
|
||||||
my $spec_files16 = \@{$self->{SPEC_FILES16}};
|
my $spec_file_found = $self->read_module_file();
|
||||||
my $spec_files32 = \@{$self->{SPEC_FILES32}};
|
$self->read_spec_files($spec_file_found);
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub read_module_file {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
|
my $dir2spec_file = \%{$self->{DIR2SPEC_FILE}};
|
||||||
my $spec_file2dir = \%{$self->{SPEC_FILE2DIR}};
|
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";
|
my $module_file = "$winapi_check_dir/modules.dat";
|
||||||
|
|
||||||
$output->progress("modules.dat");
|
$output->progress("modules.dat");
|
||||||
|
|
||||||
my %spec_file_found;
|
my $spec_file_found = {};
|
||||||
my $allowed_dir;
|
my $allowed_dir;
|
||||||
my $spec_file;
|
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");
|
$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} = {};
|
$$spec_file2dir{$spec_file} = {};
|
||||||
next;
|
next;
|
||||||
} else {
|
} else {
|
||||||
|
@ -129,6 +140,20 @@ sub new {
|
||||||
}
|
}
|
||||||
close(IN);
|
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;
|
my @spec_files;
|
||||||
if($wine_dir eq ".") {
|
if($wine_dir eq ".") {
|
||||||
@spec_files = get_spec_files("winelib");
|
@spec_files = get_spec_files("winelib");
|
||||||
|
@ -162,14 +187,10 @@ sub new {
|
||||||
}
|
}
|
||||||
|
|
||||||
foreach my $spec_file (@spec_files) {
|
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");
|
$output->write("modules.dat: $spec_file: exists but is not specified\n");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
$modules = $self;
|
|
||||||
|
|
||||||
return $self;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub all_modules {
|
sub all_modules {
|
||||||
|
|
|
@ -22,9 +22,10 @@ use base qw(function);
|
||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
use config qw($current_dir $wine_dir);
|
use config qw($current_dir $wine_dir);
|
||||||
use modules qw($modules);
|
|
||||||
use util qw(&normalize_set);
|
use util qw(&normalize_set);
|
||||||
use winapi qw($win16api $win32api @winapis);
|
|
||||||
|
my $import = 0;
|
||||||
|
use vars qw($modules $win16api $win32api @winapis);
|
||||||
|
|
||||||
########################################################################
|
########################################################################
|
||||||
# constructor
|
# constructor
|
||||||
|
@ -36,6 +37,15 @@ sub new {
|
||||||
my $self = {};
|
my $self = {};
|
||||||
bless ($self, $class);
|
bless ($self, $class);
|
||||||
|
|
||||||
|
if (!$import) {
|
||||||
|
require modules;
|
||||||
|
import modules qw($modules);
|
||||||
|
|
||||||
|
require winapi;
|
||||||
|
import winapi qw($win16api $win32api @winapis);
|
||||||
|
|
||||||
|
$import = 1;
|
||||||
|
}
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue