mysql-test-run.pl:

  Corrected typo
mtr_diff.pl:
  A simplified unified diff in Perl
  new file


mysql-test/lib/mtr_diff.pl:
  A simplified unified diff in Perl
mysql-test/mysql-test-run.pl:
  Corrected typo

2 files changed, 286 insertions, 2 deletions

diff --git a/mysql-test/lib/mtr_diff.pl b/mysql-test/lib/mtr_diff.pl
new file mode 100644
index 00000000000..4e927ff4e37
--- /dev/null
+++ b/mysql-test/lib/mtr_diff.pl
@@ -0,0 +1,283 @@
+# -*- cperl -*-
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+#use Data::Dumper;
+use strict;
+
+# $Data::Dumper::Indent= 1;
+
+sub mtr_diff($$);
+
+##############################################################################
+#
+#  This is a simplified unified diff, with some special handling
+#  of unsorted result sets
+#
+##############################################################################
+
+# FIXME replace die with mtr_error
+
+#require "mtr_report.pl";
+#mtr_diff("a.txt","b.txt");
+
+sub mtr_diff ($$) {
+  my $file1 = shift;
+  my $file2 = shift;
+
+  # ----------------------------------------------------------------------
+  # We read in all of the files at once
+  # ----------------------------------------------------------------------
+
+  unless ( open(FILE1, $file1) )
+  {
+    mtr_warning("can't open \"$file1\": $!");
+    return;
+  }
+
+  unless ( open(FILE2, $file2) )
+  {
+    mtr_warning("can't open \"$file2\": $!");
+    return;
+  }
+
+  my $lines1= collect_lines(<FILE1>);
+  my $lines2= collect_lines(<FILE2>);
+  close FILE1;
+  close FILE2;
+
+#  print Dumper($lines1);
+#  print Dumper($lines2);
+
+  # ----------------------------------------------------------------------
+  # We compare line by line, but don't shift off elements until we know
+  # what to do. This way we use the "restart" method, do simple change
+  # and restart by entering the diff loop from the beginning again.
+  # ----------------------------------------------------------------------
+
+  my @context;
+  my @info;                     # Collect information, and output later
+  my $lno1= 1;
+  my $lno2= 1;
+
+  while ( @$lines1 or @$lines2 )
+  {
+    unless ( @$lines1 )
+    {
+      push(@info, map {['+',$lno1,$lno2++,$_]} @$lines2);
+      last;
+    }
+    unless ( @$lines2 )
+    {
+      push(@info, map {['-',$lno1++,$lno2,$_]} @$lines1);
+      last;
+    }
+
+    # ----------------------------------------------------------------------
+    # We know both have lines
+    # ----------------------------------------------------------------------
+
+    if ( $lines1->[0] eq $lines2->[0] )
+    {
+      # Simple case, first line match and all is well
+      push(@info, ['',$lno1++,$lno2++,$lines1->[0]]);
+      shift @$lines1;
+      shift @$lines2;
+      next;
+    }
+
+    # ----------------------------------------------------------------------
+    # Now, we know they differ
+    # ----------------------------------------------------------------------
+
+    # How far in the other one, is there a match?
+
+    my $idx2= find_next_match($lines1->[0], $lines2);
+    my $idx1= find_next_match($lines2->[0], $lines1);
+
+    # Here we could test "if ( !defined $idx2 or !defined $idx1 )" and
+    # use a more complicated diff algorithm in the case both contains
+    # each others lines, just dislocated. But for this application, there
+    # should be no need.
+
+    if ( !defined $idx2 )
+    {
+      push(@info, ['-',$lno1++,$lno2,$lines1->[0]]);
+      shift @$lines1;
+    }
+    else
+    {
+      push(@info, ['+',$lno1,$lno2++,$lines2->[0]]);
+      shift @$lines2;
+    }
+  }
+
+  # ----------------------------------------------------------------------
+  # Try to output nicely
+  # ----------------------------------------------------------------------
+
+#  print Dumper(\@info);
+
+  # We divide into "chunks" to output
+  # We want at least three lines of context
+
+  my @chunks;
+  my @chunk;
+  my $state= 'pre';          # 'pre', 'in' and 'post' difference
+  my $post_count= 0;
+
+  foreach my $info ( @info )
+  {
+    if ( $info->[0] eq '' and $state eq 'pre' )
+    {
+      # Collect no more than three lines of context before diff
+      push(@chunk, $info);
+      shift(@chunk) if @chunk > 3;
+      next;
+    }
+
+    if ( $info->[0] =~ /(\+|\-)/ and $state =~ /(pre|in)/ )
+    {
+      # Start/continue collecting diff
+      $state= 'in';
+      push(@chunk, $info);
+      next;
+    }
+
+    if ( $info->[0] eq '' and $state eq 'in' )
+    {
+      # Stop collecting diff, and collect context after diff
+      $state= 'post';
+      $post_count= 1;
+      push(@chunk, $info);
+      next;
+    }
+
+    if ( $info->[0] eq '' and $state eq 'post' and $post_count < 6 )
+    {
+      # We might find a new diff sequence soon, continue to collect
+      # non diffs but five up on 6.
+      $post_count++;
+      push(@chunk, $info);
+      next;
+    }
+
+    if ( $info->[0] eq '' and $state eq 'post' )
+    {
+      # We put an end to this, giving three non diff lines to
+      # the old chunk, and three to the new one.
+      my @left= splice(@chunk, -3, 3);
+      push(@chunks, [@chunk]);
+      $state= 'pre';
+      $post_count= 0;
+      @chunk= @left;
+      next;
+    }
+
+    if ( $info->[0] =~ /(\+|\-)/ and $state eq 'post' )
+    {
+      # We didn't split, continue collect diff
+      $state= 'in';
+      push(@chunk, $info);
+      next;
+    }
+
+  }
+
+  if ( $post_count > 3 )
+  {
+    $post_count -= 3;
+    splice(@chunk, -$post_count, $post_count);
+  }
+  push(@chunks, [@chunk]) if @chunk and $state ne 'pre';
+
+  foreach my $chunk ( @chunks )
+  {
+    my $from_file_start=  $chunk->[0]->[1];
+    my $to_file_start=    $chunk->[0]->[2];
+    my $from_file_offset= $chunk->[$#$chunk]->[1] - $from_file_start;
+    my $to_file_offset=   $chunk->[$#$chunk]->[2] - $to_file_start;
+    print "\@\@ -$from_file_start,$from_file_offset ",
+          "+$to_file_start,$to_file_offset \@\@\n";
+
+    foreach my $info ( @$chunk )
+    {
+      if ( $info->[0] eq '' )
+      {
+        print "  $info->[3]\n";
+      }
+      elsif ( $info->[0] eq '-' )
+      {
+        print "- $info->[3]\n";
+      }
+      elsif ( $info->[0] eq '+' )
+      {
+        print "+ $info->[3]\n";
+      }
+    }
+  }
+
+#  print Dumper(\@chunks);
+  
+}
+
+
+##############################################################################
+#  Find if the string is found in the array, return the index if found,
+#  if not found, return "undef"
+##############################################################################
+
+sub find_next_match {
+  my $line= shift;
+  my $lines= shift;
+
+  for ( my $idx= 0; $idx < @$lines; $idx++ )
+  {
+    return $idx if $lines->[$idx] eq $line;
+  }
+
+  return undef;                 # No match found
+}
+
+
+##############################################################################
+#  Just read the lines, but handle "sets" of lines that are unordered
+##############################################################################
+
+sub collect_lines {
+
+  my @recordset;
+  my @lines;
+
+  while (@_)
+  {
+    my $line= shift @_;
+    chomp($line);
+
+    if ( $line =~ /^\Q%unordered%\E\t/ )
+    {
+      push(@recordset, $line);
+    }
+    elsif ( @recordset )
+    {
+      push(@lines, sort @recordset);
+      @recordset= ();         # Clear it
+    }
+    else
+    {
+      push(@lines, $line);
+    }
+  }
+
+  if ( @recordset )
+  {
+    push(@lines, sort @recordset);
+    @recordset= ();         # Clear it
+  }
+
+  return \@lines;
+}
+
+1;
diff --git a/mysql-test/mysql-test-run.pl b/mysql-test/mysql-test-run.pl
index 73ca47ac809..ae5caa8044a 100755
--- a/mysql-test/mysql-test-run.pl
+++ b/mysql-test/mysql-test-run.pl
@@ -94,6 +94,7 @@ require "lib/mtr_io.pl";
 require "lib/mtr_gcov.pl";
 require "lib/mtr_gprof.pl";
 require "lib/mtr_report.pl";
+require "lib/mtr_diff.pl";
 require "lib/mtr_match.pl";
 require "lib/mtr_misc.pl";
 
@@ -1668,13 +1669,13 @@ sub mysqld_arguments ($$$$$) {
 
     mtr_add_arg($args, "%s--datadir=%s", $prefix,
                 $slave->[$idx]->{'path_myddir'});
-    % FIXME slave get this option twice?!
+    # FIXME slave get this option twice?!
     mtr_add_arg($args, "%s--exit-info=256", $prefix);
     mtr_add_arg($args, "%s--init-rpl-role=slave", $prefix);
     mtr_add_arg($args, "%s--log-bin=%s/var/log/slave%s-bin", $prefix,
                 $glob_mysql_test_dir, $sidx); # FIXME use own dir for binlogs
     mtr_add_arg($args, "%s--log-slave-updates", $prefix);
-    % FIXME option duplicated for slave
+    # FIXME option duplicated for slave
     mtr_add_arg($args, "%s--log=%s", $prefix,
                 $slave->[$idx]->{'path_mylog'});
     mtr_add_arg($args, "%s--master-retry-count=10", $prefix);