xapian-letor/tests/collate-test

   1 #!/usr/bin/perl -w
   2 # collate-test: Collate testcases from several source files.
   3 #
   4 # Copyright (C) 2007,2008,2011,2015 Olly Betts
   5 # Copyright (C) 2008 Lemur Consulting Ltd
   6 #
   7 # This program is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU General Public License as
   9 # published by the Free Software Foundation; either version 2 of the
  10 # License, or (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  20
  21 use strict;
  22
  23 my $generated_warning =
  24 "/* Warning: This file is generated by $0 - do not modify directly! */\n";
  25
  26 my %by_cond = ();
  27 my $srcdir = shift @ARGV;
  28 my $collated_hdr = shift @ARGV;
  29 my $allfile = shift @ARGV;
  30
  31 open COLLATED_HDR, ">$collated_hdr.tmp" or die $!;
  32 print COLLATED_HDR "$generated_warning\n";
  33
  34 open ALL, ">$allfile.tmp" or die $!;
  35 print ALL $generated_warning;
  36
  37 for my $cc_source (@ARGV) {
  38     (my $generated_h = $cc_source) =~ s/\.\w+$/\.h/;
  39     print ALL "#include \"$generated_h\"\n";
  40
  41     -f $cc_source or $cc_source = "$srcdir/$cc_source";
  42
  43     open HDR, ">$generated_h.tmp" or die $!;
  44     print HDR $generated_warning;
  45     open SRC, "<$cc_source" or die $!;
  46     my $ignore = 0;
  47     my @if_stack;
  48     while (<SRC>) {
  49         if (!$ignore && /^DEFINE_TESTCASE\((.*?),\s*(.*)\)/) {
  50             my ($test_func, $cond) = ($1, $2);
  51             $cond =~ s/\s+//g;
  52             push @{$by_cond{$cond}}, $test_func;
  53             print HDR "extern bool test_$test_func();\n";
  54         }
  55         if (s/^#\s*//) {
  56             s!/\*.*?\*/! !g;
  57             s!//.*!!;
  58             if (/^if\s*0\s*$/) {
  59                 push @if_stack, $ignore;
  60                 $ignore = 1;
  61             } elsif (/^if/) {
  62                 push @if_stack, $ignore;
  63             } elsif (/^endif/) {
  64                 $ignore = pop @if_stack;
  65             }
  66         }
  67     }
  68     close SRC;
  69     close HDR or die $!;
  70     update_if_required($generated_h);
  71 }
  72
  73 foreach my $cond (sort keys %by_cond) {
  74 #       my $name = $cond;
  75 #       $name =~ s/\&\&/_and_/g;
  76 #       $name =~ s/\|\|/_or_/g;
  77 #       $name =~ s/\!/not_/g;
  78 #       $name =~ s/\(/bra_/g;
  79 #       $name =~ s/\)/_ket/g;
  80     my $c_cond = $cond;
  81     $c_cond =~ s/\b([a-z]+)\b/(properties&\U$1\E)/g;
  82     print COLLATED_HDR <<END;
  83     if ($c_cond) {
  84         static const test_desc tests[] = {
  85 END
  86     for (@{$by_cond{$cond}}) {
  87         print COLLATED_HDR <<END;
  88             { \"$_\", test_$_ },
  89 END
  90     }
  91     print COLLATED_HDR <<END;
  92             { 0, 0 }
  93         };
  94         result = max(result, test_driver::run(tests));
  95     }
  96 END
  97 }
  98
  99 close ALL or die $!;
 100 update_if_required($allfile);
 101
 102 close COLLATED_HDR or die $!;
 103 update_if_required($collated_hdr);
 104
 105 # If $file.tmp is different to $file, rename it over the top.  Otherwise
 106 # just delete it to avoid needlessly updating $file's timestamp.
 107 sub update_if_required {
 108     my $file = shift;
 109     my $current_size = -s $file;
 110     if (defined $current_size && $current_size == -s "$file.tmp") {
 111         open OLD, "<$file" or die $!;
 112         open NEW, "<$file.tmp" or die $!;
 113         my $different = 0;
 114         while (<OLD>) {
 115             my $new = <NEW>;
 116             if ($_ ne $new) {
 117                 $different = 1;
 118                 last;
 119             }
 120         }
 121         close OLD;
 122         close NEW;
 123         if (! $different) {
 124             unlink "$file.tmp";
 125             return;
 126         }
 127     }
 128 different:
 129     unlink $file if $^O eq 'MSWin32' && defined $current_size;
 130     rename "$file.tmp", $file or dir $!;
 131 }