git.oblomov.eu Git - wine/blob - 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
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw($tests);
  29
  30 use vars qw($tests);
  31
  32 use config qw($current_dir $wine_dir $winapi_dir);
  33 use options qw($options);
  34 use output qw($output);
  35
  36 sub import(@) {
  37     $Exporter::ExportLevel++;
  38     Exporter::import(@_);
  39     $Exporter::ExportLevel--;
  40
  41     $tests = 'tests'->new;
  42 }
  43
  44 sub parse_tests_file($);
  45
  46 sub new($) {
  47     my $proto = shift;
  48     my $class = ref($proto) || $proto;
  49     my $self  = {};
  50     bless ($self, $class);
  51
  52     $self->parse_tests_file();
  53
  54     return $self;
  55 }
  56
  57 sub parse_tests_file($) {
  58     my $self = shift;
  59
  60     my $file = "tests.dat";
  61
  62     my $tests = \%{$self->{TESTS}};
  63
  64     $output->lazy_progress($file);
  65
  66     my $test_dir;
  67     my $test;
  68     my $section;
  69
  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
  75
  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} = [];
  85             }
  86             push @{$$tests{$test_dir}{$test}{$section}}, $_;
  87         } else {
  88             $output->write("$file:$.: parse error: '$_'\n");
  89             exit 1;
  90         }
  91     }
  92     close(IN);
  93 }
  94
  95 sub get_tests($$) {
  96     my $self = shift;
  97
  98     my $tests = \%{$self->{TESTS}};
  99
 100     my $test_dir = shift;
 101
 102     my %tests = ();
 103     if (defined($test_dir)) {
 104         foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 105             $tests{$test}++;
 106         }
 107     } else {
 108         foreach my $test_dir (sort(keys(%$tests))) {
 109             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 110                 $tests{$test}++;
 111             }
 112         }
 113     }
 114     return sort(keys(%tests));
 115 }
 116
 117 sub get_test_dirs($$) {
 118     my $self = shift;
 119
 120     my $tests = \%{$self->{TESTS}};
 121
 122     my $test = shift;
 123
 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}++;
 129             }
 130         }
 131     } else {
 132         foreach my $test_dir (sort(keys(%$tests))) {
 133             $test_dirs{$test_dir}++;
 134         }
 135     }
 136
 137     return sort(keys(%test_dirs));
 138 }
 139
 140 sub get_sections($$$) {
 141     my $self = shift;
 142
 143     my $tests = \%{$self->{TESTS}};
 144
 145     my $test_dir = shift;
 146     my $test = shift;
 147
 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}++;
 153             }
 154         } else {
 155             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 156                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 157                     $sections{$section}++;
 158                 }
 159             }
 160         }
 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}++;
 165             }
 166         }
 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}++;
 172                 }
 173             }
 174         }
 175     }
 176
 177     return sort(keys(%sections));
 178 }
 179
 180 sub get_section($$$$) {
 181     my $self = shift;
 182
 183     my $tests = \%{$self->{TESTS}};
 184
 185     my $test_dir = shift;
 186     my $test = shift;
 187     my $section = shift;
 188
 189     my $array = $$tests{$test_dir}{$test}{$section};
 190     if (defined($array)) {
 191         return @$array;
 192     } else {
 193         return ();
 194     }
 195 }
 196
 197 1;