lib/scripts/checkKeys.pl.in

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3
   4 # checkKeys.pl testname
   5 #   testname can be anything satisfying the pattern
   6 #            '^(keytest\/|.*autotests\/out-home\/)?([^\/]+)(|\-in\.txt|\.log[a-z]\.txt)$/
   7 #   interesting is only group(2)
   8 #
   9 # Tool to display keystrokes which made it to lyx while tested with
  10 # the lyx-session with '-dbg key'
  11 # Helpful to check where a 'keytest'-testcase failed because
  12 # of some missing/ignored key.
  13
  14 use strict;
  15
  16 my $bindir = "@CMAKE_BINARY_DIR@";
  17 my $resdir = "@LYX_ABS_TOP_SRCDIR@/development/autotests/keyresults";
  18 my $logdir = "$bindir/autotests/out-home";
  19 my $saveflag = 0;
  20 sub checkKeys($);
  21 sub displayKeys($);
  22
  23 for my $arg (@ARGV) {
  24   if ($arg =~ /^([^=]+)=([^=]+)$/) {
  25     my ($par, $val) = ($1, $2);
  26     $saveflag = $val;
  27   }
  28   else {
  29     &checkKeys($arg);
  30   }
  31 }
  32
  33 exit(0);
  34
  35 sub checkKeys($)
  36 {
  37   my ($pattern) = @_;
  38   my @logs = ();
  39
  40   $pattern =~ s/^(keytest\/|.*autotests\/out-home\/)//;
  41   $pattern =~ s/(\-in\.txt|\.log[a-z]\.txt)$//;
  42   return if ($pattern =~ /\//);
  43   if (opendir(DI, $logdir)) {
  44     while (my $f = readdir(DI)) {
  45       if ($f =~ /$pattern.*\.log([a-z])\.txt$/) {
  46         push(@logs, $f);
  47       }
  48     }
  49     closedir(DI);
  50   }
  51   @logs = sort(@logs);
  52   for my $f (@logs) {
  53     &displayKeys($f);
  54   }
  55 }
  56
  57 my $line;
  58 my @exp;
  59
  60 sub checkPrint($) {
  61   my ($str) = @_;
  62   my $saved;
  63   if (defined($exp[$line])) {
  64     $saved = $exp[$line];
  65   }
  66   else {
  67     $saved = "";
  68   }
  69   $exp[$line] = $str;
  70   $line++;
  71   if ($saved ne $str) {
  72     return 1;
  73   }
  74   return 0;
  75 }
  76
  77 sub displayKeys($)
  78 {
  79   my ($e) = @_;
  80   my $log = "$logdir/$e";
  81   my $expected = "$resdir/$e.expected";
  82
  83   @exp = ();
  84   if (open(FE, $expected)) {
  85     while (my $l = <FE>) {
  86       chomp($l);
  87       push(@exp, $l);
  88     }
  89     close(FE);
  90   }
  91   else {
  92     print "Not found file $expected\n";
  93   }
  94
  95   my $errors = 0;
  96   if (open(FI, $log)) {
  97     $line = 0;
  98     while (my $l = <FI>) {
  99       if ($l =~ /:\s+(KeySym\s+is\s+.*)$/) {
 100         my $out = $1;
 101         $errors += &checkPrint($out);
 102       }
 103       elsif ($l =~ /:\s+(Key\s+\(queried\)\s+\[action=.*)$/) {
 104         my $out = $1;
 105         $errors += &checkPrint($out);
 106       }
 107     }
 108     $errors += 1 if (defined($exp[$line]));
 109     close(FI);
 110   }
 111   if ($errors > 0) {
 112     print "Diff -u $e:\n";
 113     open(FX, "| diff -u $expected -");
 114     for (my $i=0; $i < $line; $i++) {
 115       print FX "$exp[$i]\n";
 116     }
 117     close(FX);
 118     if ($saveflag) {
 119       print "Overwriting file $expected\n";
 120       if (open(FO, '>', $expected)) {
 121         for (my $i=0; $i < $line; $i++) {
 122           print FO "$exp[$i]\n";
 123         }
 124         close(FO);
 125       }
 126     }
 127   }
 128   else {
 129     print "$e OK\n";
 130   }
 131 }