git.maemo.org Git - pkg-perl/blob - deb-src/libalgorithm-diff-perl/libalgorithm-diff-perl-1.19.02/t/base.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl base.t'
   3 use strict;
   4 $^W++;
   5 use lib qw(blib lib);
   6 use Algorithm::Diff qw(diff LCS traverse_sequences traverse_balanced sdiff);
   7 use Data::Dumper;
   8 use Test;
   9
  10 BEGIN
  11 {
  12         $|++;
  13         plan tests => 35;
  14         $SIG{__DIE__} = sub # breakpoint on die
  15         {
  16                 $DB::single = 1;
  17                 $DB::single = 1;        # avoid complaint
  18                 die @_;
  19         }
  20 }
  21
  22 my @a = qw(a b c e h j l m n p);
  23 my @b = qw(b c d e f j k l m r s t);
  24 my @correctResult = qw(b c e j l m);
  25 my $correctResult = join(' ', @correctResult);
  26 my $skippedA = 'a h n p';
  27 my $skippedB = 'd f k r s t';
  28
  29 # From the Algorithm::Diff manpage:
  30 my $correctDiffResult = [
  31         [ [ '-', 0, 'a' ] ],
  32
  33         [ [ '+', 2, 'd' ] ],
  34
  35         [ [ '-', 4, 'h' ], [ '+', 4, 'f' ] ],
  36
  37         [ [ '+', 6, 'k' ] ],
  38
  39         [
  40                 [ '-', 8,  'n' ],
  41                 [ '+', 9,  'r' ],
  42                 [ '-', 9,  'p' ],
  43                 [ '+', 10, 's' ],
  44                 [ '+', 11, 't' ],
  45         ]
  46 ];
  47
  48 # Result of LCS must be as long as @a
  49 my @result = Algorithm::Diff::_longestCommonSubsequence( \@a, \@b );
  50 ok( scalar(grep { defined } @result),
  51         scalar(@correctResult),
  52         "length of _longestCommonSubsequence" );
  53
  54 # result has b[] line#s keyed by a[] line#
  55 # print "result =", join(" ", map { defined($_) ? $_ : 'undef' } @result), "\n";
  56
  57 my @aresult = map { defined( $result[$_] ) ? $a[$_] : () } 0 .. $#result;
  58 my @bresult =
  59   map { defined( $result[$_] ) ? $b[ $result[$_] ] : () } 0 .. $#result;
  60
  61 ok( "@aresult", $correctResult, "A results" );
  62 ok( "@bresult", $correctResult, "B results" );
  63
  64 my ( @matchedA, @matchedB, @discardsA, @discardsB, $finishedA, $finishedB );
  65
  66 sub match
  67 {
  68         my ( $a, $b ) = @_;
  69         push ( @matchedA, $a[$a] );
  70         push ( @matchedB, $b[$b] );
  71 }
  72
  73 sub discard_b
  74 {
  75         my ( $a, $b ) = @_;
  76         push ( @discardsB, $b[$b] );
  77 }
  78
  79 sub discard_a
  80 {
  81         my ( $a, $b ) = @_;
  82         push ( @discardsA, $a[$a] );
  83 }
  84
  85 sub finished_a
  86 {
  87         my ( $a, $b ) = @_;
  88         $finishedA = $a;
  89 }
  90
  91 sub finished_b
  92 {
  93         my ( $a, $b ) = @_;
  94         $finishedB = $b;
  95 }
  96
  97 traverse_sequences(
  98         \@a,
  99         \@b,
 100         {
 101                 MATCH     => \&match,
 102                 DISCARD_A => \&discard_a,
 103                 DISCARD_B => \&discard_b
 104         }
 105 );
 106
 107 ok( "@matchedA", $correctResult);
 108 ok( "@matchedB", $correctResult);
 109 ok( "@discardsA", $skippedA);
 110 ok( "@discardsB", $skippedB);
 111
 112 @matchedA = @matchedB = @discardsA = @discardsB = ();
 113 $finishedA = $finishedB = undef;
 114
 115 traverse_sequences(
 116         \@a,
 117         \@b,
 118         {
 119                 MATCH      => \&match,
 120                 DISCARD_A  => \&discard_a,
 121                 DISCARD_B  => \&discard_b,
 122                 A_FINISHED => \&finished_a,
 123                 B_FINISHED => \&finished_b,
 124         }
 125 );
 126
 127 ok( "@matchedA", $correctResult);
 128 ok( "@matchedB", $correctResult);
 129 ok( "@discardsA", $skippedA);
 130 ok( "@discardsB", $skippedB);
 131 ok( $finishedA, 9, "index of finishedA" );
 132 ok( $finishedB, undef, "index of finishedB" );
 133
 134 my @lcs = LCS( \@a, \@b );
 135 ok( "@lcs", $correctResult );
 136
 137 # Compare the diff output with the one from the Algorithm::Diff manpage.
 138 my $diff = diff( \@a, \@b );
 139 $Data::Dumper::Indent = 0;
 140 my $cds = Dumper($correctDiffResult);
 141 my $dds = Dumper($diff);
 142 ok( $dds, $cds );
 143
 144 ##################################################
 145 # <Mike Schilli> m@perlmeister.com 03/23/2002:
 146 # Tests for sdiff-interface
 147 #################################################
 148
 149 @a = qw(abc def yyy xxx ghi jkl);
 150 @b = qw(abc dxf xxx ghi jkl);
 151 $correctDiffResult = [ ['u', 'abc', 'abc'],
 152                        ['c', 'def', 'dxf'],
 153                        ['-', 'yyy', ''],
 154                        ['u', 'xxx', 'xxx'],
 155                        ['u', 'ghi', 'ghi'],
 156                        ['u', 'jkl', 'jkl'] ];
 157 @result = sdiff(\@a, \@b);
 158 ok(Dumper(\@result), Dumper($correctDiffResult));
 159
 160
 161 #################################################
 162 @a = qw(a b c e h j l m n p);
 163 @b = qw(b c d e f j k l m r s t);
 164 $correctDiffResult = [ ['-', 'a', '' ],
 165                        ['u', 'b', 'b'],
 166                        ['u', 'c', 'c'],
 167                        ['+', '',  'd'],
 168                        ['u', 'e', 'e'],
 169                        ['c', 'h', 'f'],
 170                        ['u', 'j', 'j'],
 171                        ['+', '',  'k'],
 172                        ['u', 'l', 'l'],
 173                        ['u', 'm', 'm'],
 174                        ['c', 'n', 'r'],
 175                        ['c', 'p', 's'],
 176                        ['+', '',  't'],
 177                      ];
 178 @result = sdiff(\@a, \@b);
 179 ok(Dumper(\@result), Dumper($correctDiffResult));
 180
 181 #################################################
 182 @a = qw(a b c d e);
 183 @b = qw(a e);
 184 $correctDiffResult = [ ['u', 'a', 'a' ],
 185                        ['-', 'b', ''],
 186                        ['-', 'c', ''],
 187                        ['-', 'd', ''],
 188                        ['u', 'e', 'e'],
 189                      ];
 190 @result = sdiff(\@a, \@b);
 191 ok(Dumper(\@result), Dumper($correctDiffResult));
 192
 193 #################################################
 194 @a = qw(a e);
 195 @b = qw(a b c d e);
 196 $correctDiffResult = [ ['u', 'a', 'a' ],
 197                        ['+', '', 'b'],
 198                        ['+', '', 'c'],
 199                        ['+', '', 'd'],
 200                        ['u', 'e', 'e'],
 201                      ];
 202 @result = sdiff(\@a, \@b);
 203 ok(Dumper(\@result), Dumper($correctDiffResult));
 204
 205 #################################################
 206 @a = qw(v x a e);
 207 @b = qw(w y a b c d e);
 208 $correctDiffResult = [
 209                        ['c', 'v', 'w' ],
 210                        ['c', 'x', 'y' ],
 211                        ['u', 'a', 'a' ],
 212                        ['+', '', 'b'],
 213                        ['+', '', 'c'],
 214                        ['+', '', 'd'],
 215                        ['u', 'e', 'e'],
 216                      ];
 217 @result = sdiff(\@a, \@b);
 218 ok(Dumper(\@result), Dumper($correctDiffResult));
 219
 220 #################################################
 221 @a = qw(x a e);
 222 @b = qw(a b c d e);
 223 $correctDiffResult = [
 224                        ['-', 'x', '' ],
 225                        ['u', 'a', 'a' ],
 226                        ['+', '', 'b'],
 227                        ['+', '', 'c'],
 228                        ['+', '', 'd'],
 229                        ['u', 'e', 'e'],
 230                      ];
 231 @result = sdiff(\@a, \@b);
 232 ok(Dumper(\@result), Dumper($correctDiffResult));
 233
 234 #################################################
 235 @a = qw(a e);
 236 @b = qw(x a b c d e);
 237 $correctDiffResult = [
 238                        ['+', '', 'x' ],
 239                        ['u', 'a', 'a' ],
 240                        ['+', '', 'b'],
 241                        ['+', '', 'c'],
 242                        ['+', '', 'd'],
 243                        ['u', 'e', 'e'],
 244                      ];
 245 @result = sdiff(\@a, \@b);
 246 ok(Dumper(\@result), Dumper($correctDiffResult));
 247
 248 #################################################
 249 @a = qw(a e v);
 250 @b = qw(x a b c d e w x);
 251 $correctDiffResult = [
 252                        ['+', '', 'x' ],
 253                        ['u', 'a', 'a' ],
 254                        ['+', '', 'b'],
 255                        ['+', '', 'c'],
 256                        ['+', '', 'd'],
 257                        ['u', 'e', 'e'],
 258                        ['c', 'v', 'w'],
 259                        ['+', '',  'x'],
 260                      ];
 261 @result = sdiff(\@a, \@b);
 262 ok(Dumper(\@result), Dumper($correctDiffResult));
 263
 264 #################################################
 265 @a = qw();
 266 @b = qw(a b c);
 267 $correctDiffResult = [
 268                        ['+', '', 'a' ],
 269                        ['+', '', 'b' ],
 270                        ['+', '', 'c' ],
 271                      ];
 272 @result = sdiff(\@a, \@b);
 273 ok(Dumper(\@result), Dumper($correctDiffResult));
 274
 275 #################################################
 276 @a = qw(a b c);
 277 @b = qw();
 278 $correctDiffResult = [
 279                        ['-', 'a', '' ],
 280                        ['-', 'b', '' ],
 281                        ['-', 'c', '' ],
 282                      ];
 283 @result = sdiff(\@a, \@b);
 284 ok(Dumper(\@result), Dumper($correctDiffResult));
 285
 286 #################################################
 287 @a = qw(a b c);
 288 @b = qw(1);
 289 $correctDiffResult = [
 290                        ['c', 'a', '1' ],
 291                        ['-', 'b', '' ],
 292                        ['-', 'c', '' ],
 293                      ];
 294 @result = sdiff(\@a, \@b);
 295 ok(Dumper(\@result), Dumper($correctDiffResult));
 296
 297 #################################################
 298 @a = qw(a b c);
 299 @b = qw(c);
 300 $correctDiffResult = [
 301                        ['-', 'a', '' ],
 302                        ['-', 'b', '' ],
 303                        ['u', 'c', 'c' ],
 304                      ];
 305 @result = sdiff(\@a, \@b);
 306 ok(Dumper(\@result), Dumper($correctDiffResult));
 307
 308 #################################################
 309 @a = qw(a b c);
 310 @b = qw(a x c);
 311 my $r = "";
 312 traverse_balanced( \@a, \@b,
 313                    { MATCH     => sub { $r .= "M @_";},
 314                      DISCARD_A => sub { $r .= "DA @_";},
 315                      DISCARD_B => sub { $r .= "DB @_";},
 316                      CHANGE    => sub { $r .= "C @_";},
 317                    } );
 318 ok($r, "M 0 0C 1 1M 2 2");
 319
 320 #################################################
 321 # No CHANGE callback => use discard_a/b instead
 322 @a = qw(a b c);
 323 @b = qw(a x c);
 324 $r = "";
 325 traverse_balanced( \@a, \@b,
 326                    { MATCH     => sub { $r .= "M @_";},
 327                      DISCARD_A => sub { $r .= "DA @_";},
 328                      DISCARD_B => sub { $r .= "DB @_";},
 329                    } );
 330 ok($r, "M 0 0DA 1 1DB 2 1M 2 2");
 331
 332 #################################################
 333 @a = qw(a x y c);
 334 @b = qw(a v w c);
 335 $r = "";
 336 traverse_balanced( \@a, \@b,
 337                    { MATCH     => sub { $r .= "M @_";},
 338                      DISCARD_A => sub { $r .= "DA @_";},
 339                      DISCARD_B => sub { $r .= "DB @_";},
 340                      CHANGE    => sub { $r .= "C @_";},
 341                    } );
 342 ok($r, "M 0 0C 1 1C 2 2M 3 3");
 343
 344 #################################################
 345 @a = qw(x y c);
 346 @b = qw(v w c);
 347 $r = "";
 348 traverse_balanced( \@a, \@b,
 349                    { MATCH     => sub { $r .= "M @_";},
 350                      DISCARD_A => sub { $r .= "DA @_";},
 351                      DISCARD_B => sub { $r .= "DB @_";},
 352                      CHANGE    => sub { $r .= "C @_";},
 353                    } );
 354 ok($r, "C 0 0C 1 1M 2 2");
 355
 356 #################################################
 357 @a = qw(a x y z);
 358 @b = qw(b v w);
 359 $r = "";
 360 traverse_balanced( \@a, \@b,
 361                    { MATCH     => sub { $r .= "M @_";},
 362                      DISCARD_A => sub { $r .= "DA @_";},
 363                      DISCARD_B => sub { $r .= "DB @_";},
 364                      CHANGE    => sub { $r .= "C @_";},
 365                    } );
 366 ok($r, "C 0 0C 1 1C 2 2DA 3 3");
 367
 368 #################################################
 369 @a = qw(a z);
 370 @b = qw(a);
 371 $r = "";
 372 traverse_balanced( \@a, \@b,
 373                    { MATCH     => sub { $r .= "M @_";},
 374                      DISCARD_A => sub { $r .= "DA @_";},
 375                      DISCARD_B => sub { $r .= "DB @_";},
 376                      CHANGE    => sub { $r .= "C @_";},
 377                    } );
 378 ok($r, "M 0 0DA 1 1");
 379
 380 #################################################
 381 @a = qw(z a);
 382 @b = qw(a);
 383 $r = "";
 384 traverse_balanced( \@a, \@b,
 385                    { MATCH     => sub { $r .= "M @_";},
 386                      DISCARD_A => sub { $r .= "DA @_";},
 387                      DISCARD_B => sub { $r .= "DB @_";},
 388                      CHANGE    => sub { $r .= "C @_";},
 389                    } );
 390 ok($r, "DA 0 0M 1 0");
 391
 392 #################################################
 393 @a = qw(a b c);
 394 @b = qw(x y z);
 395 $r = "";
 396 traverse_balanced( \@a, \@b,
 397                    { MATCH     => sub { $r .= "M @_";},
 398                      DISCARD_A => sub { $r .= "DA @_";},
 399                      DISCARD_B => sub { $r .= "DB @_";},
 400                      CHANGE    => sub { $r .= "C @_";},
 401                    } );
 402 ok($r, "C 0 0C 1 1C 2 2");