Wine Cross Reference
wine/tools/winapi/tests.pm

   #
   # 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 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 parse_tests_file($);
  
  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_sections($$$) {
     my $self = shift;
 
     my $tests = \%{$self->{TESTS}};
 
     my $test_dir = shift;
     my $test = shift;
 
     my %sections = ();   
     if (defined($test_dir)) { 
         if (defined($test)) {
             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
                 $sections{$section}++;
             }
         } else {
             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
                     $sections{$section}++;
                 }
             }
         }
     } elsif (defined($test)) {
         foreach my $test_dir (sort(keys(%$tests))) {
             foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
                 $sections{$section}++;
             }
         }
     } else {
         foreach my $test_dir (sort(keys(%$tests))) {
             foreach my $test (sort(keys(%{$$tests{$test_dir}}))) {
                 foreach my $section (sort(keys(%{$$tests{$test_dir}{$test}}))) {
                     $sections{$section}++;
                 }
             }
         }
     }
 
     return sort(keys(%sections));
 }
 
 sub get_section($$$$) {
     my $self = shift;
 
     my $tests = \%{$self->{TESTS}};
 
     my $test_dir = shift;
     my $test = shift;
     my $section = shift;
 
     my $array = $$tests{$test_dir}{$test}{$section};
     if (defined($array)) {
         return @$array;
     } else {
         return ();
     }
 }
 
 1;