oleview: Add dual interfaces support to coclasses.
[wine/gsoc_dplay.git] / tools / winapi / tests.pm
blob142538cd4718da0601f724dd3c5a2cd2f3105245
2 # Copyright 2002 Patrik Stridvall
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # Lesser General Public License for more details.
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
19 package tests;
21 use strict;
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw($tests);
30 use vars qw($tests);
32 use config qw($current_dir $wine_dir $winapi_dir);
33 use options qw($options);
34 use output qw($output);
36 sub import(@) {
37 $Exporter::ExportLevel++;
38 Exporter::import(@_);
39 $Exporter::ExportLevel--;
41 $tests = 'tests'->new;
44 sub parse_tests_file($);
46 sub new($) {
47 my $proto = shift;
48 my $class = ref($proto) || $proto;
49 my $self = {};
50 bless ($self, $class);
52 $self->parse_tests_file();
54 return $self;
57 sub parse_tests_file($) {
58 my $self = shift;
60 my $file = "tests.dat";
62 my $tests = \%{$self->{TESTS}};
64 $output->lazy_progress($file);
66 my $test_dir;
67 my $test;
68 my $section;
70 open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
71 while(<IN>) {
72 s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
73 s/^(.*?)\s*#.*$/$1/; # remove comments
74 /^$/ && next; # skip empty lines
76 if (/^%%%\s*(\S+)$/) {
77 $test_dir = $1;
78 } elsif (/^%%\s*(\w+)$/) {
79 $test = $1;
80 } elsif (/^%\s*(\w+)$/) {
81 $section = $1;
82 } elsif (!/^%/) {
83 if (!exists($$tests{$test_dir}{$test}{$section})) {
84 $$tests{$test_dir}{$test}{$section} = [];
86 push @{$$tests{$test_dir}{$test}{$section}}, $_;
87 } else {
88 $output->write("$file:$.: parse error: '$_'\n");
89 exit 1;
92 close(IN);
95 sub get_tests($$) {
96 my $self = shift;
98 my $tests = \%{$self->{TESTS}};
100 my $test_dir = shift;
102 my %tests = ();
103 if (defined($test_dir)) {
104 foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
105 $tests{$test}++;
107 } else {
108 foreach my $test_dir (sort(keys(%$tests))) {
109 foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
110 $tests{$test}++;
114 return sort(keys(%tests));
117 sub get_test_dirs($$) {
118 my $self = shift;
120 my $tests = \%{$self->{TESTS}};
122 my $test = shift;
124 my %test_dirs = ();
125 if (defined($test)) {
126 foreach my $test_dir (sort(keys(%$tests))) {
127 if (exists($$tests{$test_dir}{$test})) {
128 $test_dirs{$test_dir}++;
131 } else {
132 foreach my $test_dir (sort(keys(%$tests))) {
133 $test_dirs{$test_dir}++;
137 return sort(keys(%test_dirs));
140 sub get_sections($$$) {
141 my $self = shift;
143 my $tests = \%{$self->{TESTS}};
145 my $test_dir = shift;
146 my $test = shift;
148 my %sections = ();
149 if (defined($test_dir)) {
150 if (defined($test)) {
151 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
152 $sections{$section}++;
154 } else {
155 foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
156 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
157 $sections{$section}++;
161 } elsif (defined($test)) {
162 foreach my $test_dir (sort(keys(%$tests))) {
163 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
164 $sections{$section}++;
167 } else {
168 foreach my $test_dir (sort(keys(%$tests))) {
169 foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
170 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
171 $sections{$section}++;
177 return sort(keys(%sections));
180 sub get_section($$$$) {
181 my $self = shift;
183 my $tests = \%{$self->{TESTS}};
185 my $test_dir = shift;
186 my $test = shift;
187 my $section = shift;
189 my $array = $$tests{$test_dir}{$test}{$section};
190 if (defined($array)) {
191 return @$array;
192 } else {
193 return ();