X-Git-Url: https://git.lyx.org/gitweb/?a=blobdiff_plain;f=development%2Fautotests%2FsearchPatterns.pl;h=0b299cb817b71e780c05d833b29018223726b496;hb=226e0bb2b7361646bea84098d7bab4b87018ad99;hp=0fa0d93ddbcea9e22ab81df3e081e95eda39ff96;hpb=36a3cca3ea390118985b0c6fd2cfde2fad24f622;p=lyx.git

diff --git a/development/autotests/searchPatterns.pl b/development/autotests/searchPatterns.pl
index 0fa0d93ddb..0b299cb817 100755
--- a/development/autotests/searchPatterns.pl
+++ b/development/autotests/searchPatterns.pl
@@ -12,14 +12,18 @@
 use strict;
 use warnings;
 
-sub sexit($);			# Print synax and exit
-sub readPatterns($);		# Process patterns file
-sub processLogFile($);
-sub convertPattern($);		# escape some chars, (e.g. ']' ==> '\]')
+sub sexit($);		      # Print synax and exit
+sub readPatterns($);	      # Process patterns file
+sub processLogFile($);	      #
+sub convertPattern($);	      # check for regex, comment
+sub convertSimplePattern($);  # escape some chars, (e.g. ']' ==> '\]')
+sub printInvalid($$);	      # display lines which should not match
 
+my ($logfile, $patternsfile, $basename, $newbase) = (undef, undef, undef);
 my %options = (
-  "log" => undef,
-  "patterns" => undef,
+  "log" => \$logfile,
+  "patterns" => \$patternsfile,
+  "base" => \$basename,
     );
 
 my @patterns = ();
@@ -31,11 +35,27 @@ for my $arg (@ARGV) {
   if ($arg =~ /^([^=]+)=(.+)$/) {
     my ($what, $val) = ($1, $2);
     if (exists($options{$what})) {
-      if (defined($options{$what})) {
-	print "Value for \"$what\" already defined\n";
-	&sexit(1);
+      if (defined(${$options{$what}})) {
+	print "Param \"$what\" already handled\n";
+	sexit(1);
+      }
+      ${$options{$what}} = $val;
+      if ($what ne "base") {
+	if ($what eq "log") {
+	  if ($logfile =~ /^(.+)\.log[a-z]?\.txt$/) {
+	    $newbase = $1;
+	  }
+	}
+	elsif ($what eq "patterns") {
+	  if ($patternsfile =~ /^(.+)\.ctrl$/) {
+	    $newbase = $1;
+	  }
+	}
+	else {
+	  print "Software error, unhandled param \"$what\"\n";
+	  &sexit(1);
+	}
       }
-      $options{$what} = $val;
     }
     else {
       print "Unknown param \"$what\"\n";
@@ -48,19 +68,37 @@ for my $arg (@ARGV) {
   }
 }
 
+$basename = $newbase if (! defined($basename));
+if (defined($basename)) {
+  for my $k (keys %options) {
+    next if ($k eq "base");
+    if (! defined(${$options{$k}})) {
+      if ($k eq "log") {
+	$logfile = $basename . ".loga.txt";
+      }
+      elsif ($k eq "patterns") {
+	$patternsfile = $basename . ".ctrl";
+      }
+    }
+  }
+}
 for my $k (keys %options) {
-  if (! defined($options{$k})) {
+  next if ($k eq "base");
+  if (! defined(${$options{$k}})) {
+    print "Param \"$k\" not defined\n";
     &sexit(1);
   }
-  if (! -r $options{$k}) {
-    print "File \"$options{$k}\" is not readable\n";
+  if (! -r ${$options{$k}}) {
+    print "File \"${$options{$k}}\" is not readable\n";
     &sexit(1);
   }
 }
 
 # Read patterns
-&readPatterns($options{"patterns"});
-if (&processLogFile($options{"log"}) > 0) {
+print "\nControlfile\t= $patternsfile\n";
+print "Log-file\t= $logfile\n\n";
+&readPatterns($patternsfile);
+if (&processLogFile($logfile) > 0) {
   print "Errors occured, exiting\n";
   exit(1);
 }
@@ -72,7 +110,9 @@ sub syntax()
   print "Syntax:\n";
   print " $0";
   for my $k (keys %options) {
-    print " $k=<filename>";
+    my $type = "filename";
+    $type = "basename" if ($k eq "base");
+    print " \[$k=<$type>\]";
   }
   print "\n";
 }
@@ -85,16 +125,45 @@ sub sexit($)
 }
 
 sub convertPattern($)
+{
+  my ($pat) = @_;
+  if ($pat eq "") {
+    return("");
+  }
+  return $pat if ($pat =~ /^Comment:/);
+  if ($pat =~ s/^((Err)?Regex):\s+//) {
+    # PassThrough variant
+    return($1 . ":" . $pat);
+  }
+  elsif ($pat =~ s/^((Err)?Simple):\s+//) {
+    my $ermark = $2;
+    $ermark = "" if (!defined($ermark));
+    return $ermark . "Regex:" . &convertSimplePattern($pat);
+  }
+  else {
+    # This should not happen.
+    return undef;
+  }
+}
+
+sub convertSimplePattern($)
 {
   # Convert all chars '[]()+'
   my ($pat) = @_;
   if ($pat eq "") {
     return("");
   }
-  if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}])(.*)$/) {
+  if ($pat =~ /^(.*)(\\n)(.*)$/) {
+    # do not convert '\n'
     my ($first, $found, $third) = ($1, $2, $3);
-    $first = &convertPattern($first);
-    $third = &convertPattern($third);
+    $first = &convertSimplePattern($first);
+    $third = &convertSimplePattern($third);
+    return("$first$found$third");
+  }
+  if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
+    my ($first, $found, $third) = ($1, $2, $3);
+    $first = &convertSimplePattern($first);
+    $third = &convertSimplePattern($third);
     return($first . "\\$found" . $third);
   }
   # Substitue white spaces
@@ -106,32 +175,75 @@ sub readPatterns($)
 {
   my ($patfile) = @_;
 
+  my $errors = 0;
   if (open(FP, $patfile)) {
+    my $line = 0;
     while (my $p = <FP>) {
+      $line++;
       chomp($p);
       $p = &convertPattern($p);
-      push(@patterns, $p);
+      if (defined($p)) {
+	push(@patterns, $p) if ($p ne "");
+      }
+      else {
+	print "Wrong entry in patterns-file at line $line\n";
+	$errors++;
+      }
     }
     close(FP);
   }
+  if ($errors > 0) {
+    exit(1);
+  }
 }
 
 sub processLogFile($)
 {
   my ($log) = @_;
-  my $prevl = "\n";
-
   my $found;
   my $errors = 1;
   my @savedlines = ();
   my $readsavedlines = 0;
   my $savedline;
+  my $comment = "";
   if (open(FL, $log)) {
     $errors = 0;
     my $line = 0;
+    my @ErrPatterns = ();
+    my $minprevlines = 0;
     for my $pat (@patterns) {
+      if ($pat =~ /^Comment:\s*(.*)$/) {
+	$comment = $1;
+	$comment =~ s/\s+$//;
+	if ($comment ne "") {
+	  print "............ $comment ..........\n";
+	}
+	next;
+      }
+      if ($pat =~ /^(Err)?Regex:(.*)$/) {
+	my ($type, $regex) = ($1, $2);
+	next if ($regex eq "");
+	if (defined($type)) {
+	  # This regex should not apply until next 'found line'
+	  my $erlines = () = $regex =~ /\\n/g;
+	  $minprevlines = $erlines if ($erlines > $minprevlines);
+	  push(@ErrPatterns, $regex);
+	  next;
+	}
+	else {
+	  # This is the pattern which we are looking for
+	  $pat = $regex;
+	}
+      }
       #print "Searching for \"$pat\"\n";
       $found = 0;
+      my $invalidmessages = 0;
+      my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
+      $prevlines = $minprevlines if ($prevlines < $minprevlines);
+      my @prevl = ();
+      for (my $i = 0; $i <= $prevlines; $i++) {
+	push(@prevl, "\n");
+      }
       my @lines = ();
       if ($readsavedlines) {
 	# Last regex not found
@@ -151,13 +263,20 @@ sub processLogFile($)
 	  $l = <FL>;
 	}
 	last if (! $l);
-	my $check = $prevl . $l;
-	$prevl = $l;
+	for (my $i = 0; $i < $prevlines; $i++) {
+	  $prevl[$i] = $prevl[$i+1];
+	}
+	$prevl[$prevlines] = $l;
+	my $check = join("", @prevl);
 	$line++;
 	if ($check =~ /$pat/) {
-	  print "$line:\tfound \"$pat\"\n";
+	  my $fline = $line - $prevlines;
+	  print "$fline:\tfound \"$pat\"\n";
 	  $found = 1;
-	  $prevl = "\n";	# Don't search this line again
+	  # Do not search in already found area
+	  for (my $i = 0; $i <= $prevlines; $i++) {
+	    $prevl[$i] = "\n";
+	  }
 	  if ($readsavedlines) {
 	    @savedlines = @lines;
 	  }
@@ -169,6 +288,17 @@ sub processLogFile($)
 	}
 	else {
 	  push(@savedlines, $l);
+	  # Check for not wanted patterns
+	  for my $ep (@ErrPatterns) {
+	    if ($check =~ /$ep/) {
+	      $errors++;
+	      if ($invalidmessages++ < 10) {
+		my $fline = $line - $prevlines;
+		&printInvalid($fline, $check);
+	      }
+	      last;
+	    }
+	  }
 	}
       }
       if (! $found) {
@@ -176,8 +306,20 @@ sub processLogFile($)
 	print "\tNOT found \"$pat\" in remainder of file\n";
 	$readsavedlines = 1;
       }
+      @ErrPatterns = ();	# clean search for not wanted patterns
+      $minprevlines = 0;
     }
     close(FL);
   }
   return($errors);
 }
+
+sub printInvalid($$)
+{
+  my ($line, $check) = @_;
+  my @chk = split(/\n/, $check);
+  print("$line:\tInvalid match: " . shift(@chk) . "\n");
+  for my $l (@chk) {
+    print("\t\t\t$l\n");
+  }
+}