1 #!/usr/local/bin/perl -w
6 use Algorithm::Diff qw( traverse_sequences ) ;
8 ## Each test specifies options to pass to "diff" when the --update option
9 ## is present in @ARGV and options to pass to Text::Diff::diff when the
19 'STYLE => "Context", CONTEXT => 0'
22 'STYLE => "Unified", CONTEXT => 0'
29 my @A = map "$_\n", qw( 1 2 3 4 5d 6 7 8 9 10 11 11d 12 13 ) ;
30 my @B = map "$_\n", qw( 1 2 3 4 5a 6 7 8 9 9a 10 11 12 13 ) ;
32 my $sep = ( "----8<----" x 7 ) . "\n" ;
34 if ( grep "--update", @ARGV ) {
35 my $version = `diff -v` ;
37 die "Could not determine your diff's version"
38 unless defined $version && length $version ;
40 die "Requires GNU's diff, not '$version'"
41 unless $version =~ /GNU/ ;
43 ## Here are the two files to feed to diff
44 open A, ">A" or die $! ; print A @A ; close A ;
45 open B, ">B" or die $! ; print B @B ; close B ;
48 my $mtime_B = $mtime_A + 1 ;
50 utime $mtime_A, $mtime_A, "A" or die $! ;
51 utime $mtime_B, $mtime_B, "B" or die $! ;
53 my $file_options = <<END_OPTIONS ;
60 open ME, "<$0" or die $! ;
61 my $me = join( "", <ME> ) ;
64 open BAK, ">$0.bak" or die $! ;
65 print BAK $me or die $! ;
68 my @diffs = map scalar `diff $_->[0] A B`, @tests ;
71 s/(Sun|Mon|Tue|Wed|Thu|Fri|Sat).*/<MTIME_A>/m ;
72 s/(Sun|Mon|Tue|Wed|Thu|Fri|Sat).*/<MTIME_B>/m ;
75 $me =~ s/^(__DATA__\n).*//ms ;
76 open ME, ">$0" or die $! ;
80 join $sep, "$file_options\n", @diffs
84 # unlink "A" or warn "$! unlinking A" ;
85 # unlink "B" or warn "$! unlinking B" ;
89 ## Ok, we're not updating, so run the tests...
91 my @data = split $sep, join "", <DATA> ;
92 close DATA or die $! ;
94 " elements, not ", ( @tests + 1 ),
95 ", time to --update?\n"
96 unless @data == @tests + 1 ;
98 my @file_options = eval "(" . shift( @data ) . ")" ;
101 my ( $mtime_A, $mtime_B ) ;
104 my %o = @file_options ;
105 $mtime_A = $o{MTIME_A} ;
106 $mtime_B = $o{MTIME_B} ;
109 plan tests => scalar @tests ;
111 my ( $diff_opts, $Diff_opts ) = @$_ ;
112 my $expect = shift @data ;
114 $expect =~ s/<MTIME_A>/localtime $mtime_A/e ;
115 $expect =~ s/<MTIME_B>/localtime $mtime_B/e ;
117 my @Diff_opts = eval "($Diff_opts)" ;
120 my $output = diff \@A, \@B, { @file_options, @Diff_opts } ;
121 if ( $output eq $expect ) {
126 warn "# diff options: $diff_opts\n" ;
127 warn "# my options: $Diff_opts\n" ;
128 ## Merge the outputs using A::D
129 my @E = split /^/, $expect ;
130 my @G = split /^/, $output ;
131 my $w = length "Expected" ;
134 $w = length if length > $w ;
136 my $fmt = "# %-${w}s %-2s %-${w}s\n" ;
137 printf STDERR $fmt, "Expected", " ", "Got" ;
138 print STDERR "# ", "-" x ( $w * 2 + 4 ), "\n" ;
140 my ( $E_start, $G_start ) ;
141 my $print_diff = sub {
142 my ( $E_end, $G_end ) = @_ ;
143 if ( defined $E_start || defined $G_start ) {
144 while ( $E_start < $E_end || $G_start < $G_end ) {
147 $E_start < $E_end ? $E[$E_start] : "",
149 $G_start < $G_end ? $G[$G_start] : ""
155 $E_start = $G_start = undef ;
161 $E_start = $_[0] unless defined $E_start ;
162 $G_start = $_[1] unless defined $G_start ;
169 $print_diff->( @_ ) ;
170 printf STDERR $fmt, $E[$_[0]], "==", $G[$_[1]] ;
176 $print_diff->( scalar @E, scalar @G ) ;
178 print STDERR "# ", "-" x ( $w * 2 + 4 ), "\n" ;
186 MTIME_A => 1007983243,
188 MTIME_B => 1007983244,
190 ----8<--------8<--------8<--------8<--------8<--------8<--------8<----
209 ----8<--------8<--------8<--------8<--------8<--------8<--------8<----
241 ----8<--------8<--------8<--------8<--------8<--------8<--------8<----
257 ----8<--------8<--------8<--------8<--------8<--------8<--------8<----
267 ----8<--------8<--------8<--------8<--------8<--------8<--------8<----