tools/winapi/tests.pm

   1 #
   2 # Copyright 2002 Patrik Stridvall
   3 #
   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.
   8 #
   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.
  13 #
  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
  17 #
  18
  19 package tests;
  20
  21 use strict;
  22 use warnings 'all';
  23
  24 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  25 require Exporter;
  26
  27 @ISA = qw(Exporter);
  28 @EXPORT = qw();
  29 @EXPORT_OK = qw($tests);
  30
  31 use vars qw($tests);
  32
  33 use config qw($current_dir $wine_dir $winapi_dir);
  34 use options qw($options);
  35 use output qw($output);
  36
  37 sub import(@) {
  38     $Exporter::ExportLevel++;
  39     Exporter::import(@_);
  40     $Exporter::ExportLevel--;
  41
  42     $tests = 'tests'->new;
  43 }
  44
  45 sub parse_tests_file($);
  46
  47 sub new($) {
  48     my $proto = shift;
  49     my $class = ref($proto) || $proto;
  50     my $self  = {};
  51     bless ($self, $class);
  52
  53     $self->parse_tests_file();
  54
  55     return $self;
  56 }
  57
  58 sub parse_tests_file($) {
  59     my $self = shift;
  60
  61     my $file = "tests.dat";
  62
  63     my $tests = \%{$self->{TESTS}};
  64
  65     $output->lazy_progress($file);
  66
  67     my $test_dir;
  68     my $test;
  69     my $section;
  70
  71     open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
  72     while(<IN>) {
  73         s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
  74         s/^(.*?)\s*#.*$/$1/;  # remove comments
  75         /^$/ && next;         # skip empty lines
  76
  77         if (/^%%%\s*(\S+)$/) {
  78             $test_dir = $1;
  79         } elsif (/^%%\s*(\w+)$/) {
  80             $test = $1;
  81         } elsif (/^%\s*(\w+)$/) {
  82             $section = $1;
  83         } elsif (!/^%/) {
  84             if (!exists($$tests{$test_dir}{$test}{$section})) {
  85                 $$tests{$test_dir}{$test}{$section} = [];
  86             }
  87             push @{$$tests{$test_dir}{$test}{$section}}, $_;
  88         } else {
  89             $output->write("$file:$.: parse error: '$_'\n");
  90             exit 1;
  91         }
  92     }
  93     close(IN);
  94 }
  95
  96 sub get_tests($$) {
  97     my $self = shift;
  98
  99     my $tests = \%{$self->{TESTS}};
 100
 101     my $test_dir = shift;
 102
 103     my %tests = ();
 104     if (defined($test_dir)) {
 105         foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 106             $tests{$test}++;
 107         }
 108     } else {
 109         foreach my $test_dir (sort(keys(%$tests))) {
 110             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 111                 $tests{$test}++;
 112             }
 113         }
 114     }
 115     return sort(keys(%tests));
 116 }
 117
 118 sub get_test_dirs($$) {
 119     my $self = shift;
 120
 121     my $tests = \%{$self->{TESTS}};
 122
 123     my $test = shift;
 124
 125     my %test_dirs = ();
 126     if (defined($test)) {
 127         foreach my $test_dir (sort(keys(%$tests))) {
 128             if (exists($$tests{$test_dir}{$test})) {
 129                 $test_dirs{$test_dir}++;
 130             }
 131         }
 132     } else {
 133         foreach my $test_dir (sort(keys(%$tests))) {
 134             $test_dirs{$test_dir}++;
 135         }
 136     }
 137
 138     return sort(keys(%test_dirs));
 139 }
 140
 141 sub get_sections($$$) {
 142     my $self = shift;
 143
 144     my $tests = \%{$self->{TESTS}};
 145
 146     my $test_dir = shift;
 147     my $test = shift;
 148
 149     my %sections = ();
 150     if (defined($test_dir)) {
 151         if (defined($test)) {
 152             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 153                 $sections{$section}++;
 154             }
 155         } else {
 156             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 157                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 158                     $sections{$section}++;
 159                 }
 160             }
 161         }
 162     } elsif (defined($test)) {
 163         foreach my $test_dir (sort(keys(%$tests))) {
 164             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 165                 $sections{$section}++;
 166             }
 167         }
 168     } else {
 169         foreach my $test_dir (sort(keys(%$tests))) {
 170             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 171                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 172                     $sections{$section}++;
 173                 }
 174             }
 175         }
 176     }
 177
 178     return sort(keys(%sections));
 179 }
 180
 181 sub get_section($$$$) {
 182     my $self = shift;
 183
 184     my $tests = \%{$self->{TESTS}};
 185
 186     my $test_dir = shift;
 187     my $test = shift;
 188     my $section = shift;
 189
 190     my $array = $$tests{$test_dir}{$test}{$section};
 191     if (defined($array)) {
 192         return @$array;
 193     } else {
 194         return ();
 195     }
 196 }
 197
 198 1;