← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to mysql-test/lib/mtr_diff.pl

  • Committer: brian
  • Date: 2008-06-25 05:29:13 UTC
  • Revision ID: brian@localhost.localdomain-20080625052913-6upwo0jsrl4lnapl
clean slate

Show diffs side-by-side

added added

removed removed

Lines of Context:
mysql-test/lib/mtr_diff.pl
 
1
# -*- cperl -*-
 
2
# Copyright (C) 2005 MySQL AB
 
3
# 
 
4
# This program is free software; you can redistribute it and/or modify
 
5
# it under the terms of the GNU General Public License as published by
 
6
# the Free Software Foundation; version 2 of the License.
 
7
# 
 
8
# This program is distributed in the hope that it will be useful,
 
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
# GNU General Public License for more details.
 
12
# 
 
13
# You should have received a copy of the GNU General Public License
 
14
# along with this program; if not, write to the Free Software
 
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
16
 
 
17
# This is a library file used by the Perl version of mysql-test-run,
 
18
# and is part of the translation of the Bourne shell script with the
 
19
# same name.
 
20
 
 
21
#use Data::Dumper;
 
22
use strict;
 
23
 
 
24
# $Data::Dumper::Indent= 1;
 
25
 
 
26
sub mtr_diff($$);
 
27
 
 
28
##############################################################################
 
29
#
 
30
#  This is a simplified unified diff, with some special handling
 
31
#  of unsorted result sets
 
32
#
 
33
##############################################################################
 
34
 
 
35
# FIXME replace die with mtr_error
 
36
 
 
37
#require "mtr_report.pl";
 
38
#mtr_diff("a.txt","b.txt");
 
39
 
 
40
sub mtr_diff ($$) {
 
41
  my $file1 = shift;
 
42
  my $file2 = shift;
 
43
 
 
44
  # ----------------------------------------------------------------------
 
45
  # We read in all of the files at once
 
46
  # ----------------------------------------------------------------------
 
47
 
 
48
  unless ( open(FILE1, $file1) )
 
49
  {
 
50
    mtr_warning("can't open \"$file1\": $!");
 
51
    return;
 
52
  }
 
53
 
 
54
  unless ( open(FILE2, $file2) )
 
55
  {
 
56
    mtr_warning("can't open \"$file2\": $!");
 
57
    return;
 
58
  }
 
59
 
 
60
  my $lines1= collect_lines(<FILE1>);
 
61
  my $lines2= collect_lines(<FILE2>);
 
62
  close FILE1;
 
63
  close FILE2;
 
64
 
 
65
#  print Dumper($lines1);
 
66
#  print Dumper($lines2);
 
67
 
 
68
  # ----------------------------------------------------------------------
 
69
  # We compare line by line, but don't shift off elements until we know
 
70
  # what to do. This way we use the "restart" method, do simple change
 
71
  # and restart by entering the diff loop from the beginning again.
 
72
  # ----------------------------------------------------------------------
 
73
 
 
74
  my @context;
 
75
  my @info;                     # Collect information, and output later
 
76
  my $lno1= 1;
 
77
  my $lno2= 1;
 
78
 
 
79
  while ( @$lines1 or @$lines2 )
 
80
  {
 
81
    unless ( @$lines1 )
 
82
    {
 
83
      push(@info, map {['+',$lno1,$lno2++,$_]} @$lines2);
 
84
      last;
 
85
    }
 
86
    unless ( @$lines2 )
 
87
    {
 
88
      push(@info, map {['-',$lno1++,$lno2,$_]} @$lines1);
 
89
      last;
 
90
    }
 
91
 
 
92
    # ----------------------------------------------------------------------
 
93
    # We know both have lines
 
94
    # ----------------------------------------------------------------------
 
95
 
 
96
    if ( $lines1->[0] eq $lines2->[0] )
 
97
    {
 
98
      # Simple case, first line match and all is well
 
99
      push(@info, ['',$lno1++,$lno2++,$lines1->[0]]);
 
100
      shift @$lines1;
 
101
      shift @$lines2;
 
102
      next;
 
103
    }
 
104
 
 
105
    # ----------------------------------------------------------------------
 
106
    # Now, we know they differ
 
107
    # ----------------------------------------------------------------------
 
108
 
 
109
    # How far in the other one, is there a match?
 
110
 
 
111
    my $idx2= find_next_match($lines1->[0], $lines2);
 
112
    my $idx1= find_next_match($lines2->[0], $lines1);
 
113
 
 
114
    # Here we could test "if ( !defined $idx2 or !defined $idx1 )" and
 
115
    # use a more complicated diff algorithm in the case both contains
 
116
    # each others lines, just dislocated. But for this application, there
 
117
    # should be no need.
 
118
 
 
119
    if ( !defined $idx2 )
 
120
    {
 
121
      push(@info, ['-',$lno1++,$lno2,$lines1->[0]]);
 
122
      shift @$lines1;
 
123
    }
 
124
    else
 
125
    {
 
126
      push(@info, ['+',$lno1,$lno2++,$lines2->[0]]);
 
127
      shift @$lines2;
 
128
    }
 
129
  }
 
130
 
 
131
  # ----------------------------------------------------------------------
 
132
  # Try to output nicely
 
133
  # ----------------------------------------------------------------------
 
134
 
 
135
#  print Dumper(\@info);
 
136
 
 
137
  # We divide into "chunks" to output
 
138
  # We want at least three lines of context
 
139
 
 
140
  my @chunks;
 
141
  my @chunk;
 
142
  my $state= 'pre';          # 'pre', 'in' and 'post' difference
 
143
  my $post_count= 0;
 
144
 
 
145
  foreach my $info ( @info )
 
146
  {
 
147
    if ( $info->[0] eq '' and $state eq 'pre' )
 
148
    {
 
149
      # Collect no more than three lines of context before diff
 
150
      push(@chunk, $info);
 
151
      shift(@chunk) if @chunk > 3;
 
152
      next;
 
153
    }
 
154
 
 
155
    if ( $info->[0] =~ /(\+|\-)/ and $state =~ /(pre|in)/ )
 
156
    {
 
157
      # Start/continue collecting diff
 
158
      $state= 'in';
 
159
      push(@chunk, $info);
 
160
      next;
 
161
    }
 
162
 
 
163
    if ( $info->[0] eq '' and $state eq 'in' )
 
164
    {
 
165
      # Stop collecting diff, and collect context after diff
 
166
      $state= 'post';
 
167
      $post_count= 1;
 
168
      push(@chunk, $info);
 
169
      next;
 
170
    }
 
171
 
 
172
    if ( $info->[0] eq '' and $state eq 'post' and $post_count < 6 )
 
173
    {
 
174
      # We might find a new diff sequence soon, continue to collect
 
175
      # non diffs but five up on 6.
 
176
      $post_count++;
 
177
      push(@chunk, $info);
 
178
      next;
 
179
    }
 
180
 
 
181
    if ( $info->[0] eq '' and $state eq 'post' )
 
182
    {
 
183
      # We put an end to this, giving three non diff lines to
 
184
      # the old chunk, and three to the new one.
 
185
      my @left= splice(@chunk, -3, 3);
 
186
      push(@chunks, [@chunk]);
 
187
      $state= 'pre';
 
188
      $post_count= 0;
 
189
      @chunk= @left;
 
190
      next;
 
191
    }
 
192
 
 
193
    if ( $info->[0] =~ /(\+|\-)/ and $state eq 'post' )
 
194
    {
 
195
      # We didn't split, continue collect diff
 
196
      $state= 'in';
 
197
      push(@chunk, $info);
 
198
      next;
 
199
    }
 
200
 
 
201
  }
 
202
 
 
203
  if ( $post_count > 3 )
 
204
  {
 
205
    $post_count -= 3;
 
206
    splice(@chunk, -$post_count, $post_count);
 
207
  }
 
208
  push(@chunks, [@chunk]) if @chunk and $state ne 'pre';
 
209
 
 
210
  foreach my $chunk ( @chunks )
 
211
  {
 
212
    my $from_file_start=  $chunk->[0]->[1];
 
213
    my $to_file_start=    $chunk->[0]->[2];
 
214
    my $from_file_offset= $chunk->[$#$chunk]->[1] - $from_file_start;
 
215
    my $to_file_offset=   $chunk->[$#$chunk]->[2] - $to_file_start;
 
216
    print "\@\@ -$from_file_start,$from_file_offset ",
 
217
          "+$to_file_start,$to_file_offset \@\@\n";
 
218
 
 
219
    foreach my $info ( @$chunk )
 
220
    {
 
221
      if ( $info->[0] eq '' )
 
222
      {
 
223
        print "  $info->[3]\n";
 
224
      }
 
225
      elsif ( $info->[0] eq '-' )
 
226
      {
 
227
        print "- $info->[3]\n";
 
228
      }
 
229
      elsif ( $info->[0] eq '+' )
 
230
      {
 
231
        print "+ $info->[3]\n";
 
232
      }
 
233
    }
 
234
  }
 
235
 
 
236
#  print Dumper(\@chunks);
 
237
  
 
238
}
 
239
 
 
240
 
 
241
##############################################################################
 
242
#  Find if the string is found in the array, return the index if found,
 
243
#  if not found, return "undef"
 
244
##############################################################################
 
245
 
 
246
sub find_next_match {
 
247
  my $line= shift;
 
248
  my $lines= shift;
 
249
 
 
250
  for ( my $idx= 0; $idx < @$lines; $idx++ )
 
251
  {
 
252
    return $idx if $lines->[$idx] eq $line;
 
253
  }
 
254
 
 
255
  return undef;                 # No match found
 
256
}
 
257
 
 
258
 
 
259
##############################################################################
 
260
#  Just read the lines, but handle "sets" of lines that are unordered
 
261
##############################################################################
 
262
 
 
263
sub collect_lines {
 
264
 
 
265
  my @recordset;
 
266
  my @lines;
 
267
 
 
268
  while (@_)
 
269
  {
 
270
    my $line= shift @_;
 
271
    chomp($line);
 
272
 
 
273
    if ( $line =~ /^\Q%unordered%\E\t/ )
 
274
    {
 
275
      push(@recordset, $line);
 
276
    }
 
277
    elsif ( @recordset )
 
278
    {
 
279
      push(@lines, sort @recordset);
 
280
      @recordset= ();         # Clear it
 
281
    }
 
282
    else
 
283
    {
 
284
      push(@lines, $line);
 
285
    }
 
286
  }
 
287
 
 
288
  if ( @recordset )
 
289
  {
 
290
    push(@lines, sort @recordset);
 
291
    @recordset= ();         # Clear it
 
292
  }
 
293
 
 
294
  return \@lines;
 
295
}
 
296
 
 
297
1;