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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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 new {
  45     my $proto = shift;
  46     my $class = ref($proto) || $proto;
  47     my $self  = {};
  48     bless ($self, $class);
  49
  50     $self->parse_tests_file();
  51
  52     return $self;
  53 }
  54
  55 sub parse_tests_file {
  56     my $self = shift;
  57
  58     my $file = "tests.dat";
  59
  60     my $tests = \%{$self->{TESTS}};
  61
  62     $output->lazy_progress($file);
  63
  64     my $test_dir;
  65     my $test;
  66     my $section;
  67
  68     open(IN, "< $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
  69     while(<IN>) {
  70         s/^\s*?(.*?)\s*$/$1/; # remove whitespace at beginning and end of line
  71         s/^(.*?)\s*#.*$/$1/;  # remove comments
  72         /^$/ && next;         # skip empty lines
  73
  74         if (/^%%%\s*(\S+)$/) {
  75             $test_dir = $1;
  76         } elsif (/^%%\s*(\w+)$/) {
  77             $test = $1;
  78         } elsif (/^%\s*(\w+)$/) {
  79             $section = $1;
  80         } elsif (!/^%/) {
  81             if (!exists($$tests{$test_dir}{$test}{$section})) {
  82                 $$tests{$test_dir}{$test}{$section} = [];
  83             }
  84             push @{$$tests{$test_dir}{$test}{$section}}, $_;
  85         } else {
  86             $output->write("$file:$.: parse error: '$_'\n");
  87             exit 1;
  88         }
  89     }
  90     close(IN);
  91 }
  92
  93 sub get_tests {
  94     my $self = shift;
  95
  96     my $tests = \%{$self->{TESTS}};
  97
  98     my $test_dir = shift;
  99
 100     my %tests = ();
 101     if (defined($test_dir)) {
 102         foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 103             $tests{$test}++;
 104         }
 105     } else {
 106         foreach my $test_dir (sort(keys(%$tests))) {
 107             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 108                 $tests{$test}++;
 109             }
 110         }
 111     }
 112     return sort(keys(%tests));
 113 }
 114
 115 sub get_test_dirs {
 116     my $self = shift;
 117
 118     my $tests = \%{$self->{TESTS}};
 119
 120     my $test = shift;
 121
 122     my %test_dirs = ();
 123     if (defined($test)) {
 124         foreach my $test_dir (sort(keys(%$tests))) {
 125             if (exists($$tests{$test_dir}{$test})) {
 126                 $test_dirs{$test_dir}++;
 127             }
 128         }
 129     } else {
 130         foreach my $test_dir (sort(keys(%$tests))) {
 131             $test_dirs{$test_dir}++;
 132         }
 133     }
 134
 135     return sort(keys(%test_dirs));
 136 }
 137
 138 sub get_sections {
 139     my $self = shift;
 140
 141     my $tests = \%{$self->{TESTS}};
 142
 143     my $test_dir = shift;
 144     my $test = shift;
 145
 146     my %sections = ();
 147     if (defined($test_dir)) {
 148         if (defined($test)) {
 149             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 150                 $sections{$section}++;
 151             }
 152         } else {
 153             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 154                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 155                     $sections{$section}++;
 156                 }
 157             }
 158         }
 159     } elsif (defined($test)) {
 160         foreach my $test_dir (sort(keys(%$tests))) {
 161             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 162                 $sections{$section}++;
 163             }
 164         }
 165     } else {
 166         foreach my $test_dir (sort(keys(%$tests))) {
 167             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
 168                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
 169                     $sections{$section}++;
 170                 }
 171             }
 172         }
 173     }
 174
 175     return sort(keys(%sections));
 176 }
 177
 178 sub get_section {
 179     my $self = shift;
 180
 181     my $tests = \%{$self->{TESTS}};
 182
 183     my $test_dir = shift;
 184     my $test = shift;
 185     my $section = shift;
 186
 187     my $array = $$tests{$test_dir}{$test}{$section};
 188     if (defined($array)) {
 189         return @$array;
 190     } else {
 191         return ();
 192     }
 193 }
 194
 195 1;