1# `use' statements are after test definition 2 3my $error_message = 'Algorithm::Diff::diff is not symmetric for second and third sequences'; 4 5my(@tests, $tests); 6 7BEGIN { 8 9# test deletion of last member in ancestor 10push @tests, [ 11 [qw(a b c)], # ancestor 12 [qw(a b)], # left 13 [qw(a b c)], # right 14 [qw(a b)] # merge 15]; 16 17# test deletion of first member in ancestor 18push @tests, [ 19 [qw(a b c)], # ancestor 20 [qw( b c)], # left 21 [qw(a b c)], # right 22 [qw( b c)] # merge 23]; 24 25# test deletion of last member in ancestor and addition of a new last member 26push @tests, [ 27 [qw(a b c)], # ancestor 28 [qw(a b d)], # left 29 [qw(a b c d)], # right 30 [qw(a b d)] # merge 31]; 32 33# test deletion of interior member of ancestor and addition of interior member 34push @tests, [ 35 [qw(a b c e)], # ancestor 36 [qw(a b d e)], # left 37 [qw(a b c d e)], # right 38 [qw(a b d e)] # merge 39]; 40 41push @tests, [ 42 [qw(a b c e f)], # ancestor 43 [qw(a b d e f)], # left 44 [qw(a b c d e)], # right 45 [qw(a b d e)] # merge 46]; 47 48 49push @tests, [ 50 [qw(a b c e f h i k)], # ancestor 51 [qw(a b d e f g i j k)], # left 52 [qw(a b c d e h i j k)], # right 53 [qw(a b d e g i j k)] # merge 54]; 55 56push @tests, [ 57 [qw(a b c d e f g)], # ancestor 58 [qw(a b e g)], # left 59 [qw(a d e g)], # right 60 [qw(a e g)], # merge 61]; 62 63# test conflicts 64push @tests, [ 65 [qw(a b c d)], # ancestor 66 [qw(l b c d)], # left 67 [qw(r b c d)], # right 68 [qw(< l | r > b c d)], #merge 69 [qw(< r | l > b c d)] 70]; 71 72push @tests, [ 73 [qw(a b c b f b d)], 74 [qw( l b c b d)], 75 [qw( r b c b d b e)], 76 [qw(< l | r > b c b d b e)], 77 [qw(< r | l > b c b d b e)], 78]; 79 80push @tests, [ 81 [qw(a b b c b f b d)], 82 [qw( l m b c b d)], 83 [qw( r s b c b d b e)], 84 [qw( < l m | r s > b c b d b e)], 85 [qw( < r s | l m > b c b d b e)], 86]; 87 88push @tests, [ 89 [qw(a b c b f b d)], 90 [qw( l b d b d)], 91 [qw( r b e b d b e)], 92 [qw(< l | r > b < d | e > b d b e)], 93 [qw(< r | l > b < e | d > b d b e)], # Algorithm::Diff::diff should fail (see BUG section of man page) on this one 94]; 95 96push @tests, [ 97 [qw(a b c b f b c d)], 98 [qw( l b d b d)], 99 [qw( r b e b d b e)], 100 [qw(< l | r > b < d | e > b d b e)], 101 [qw(< r | l > b < e | d > b d b e)], # Algorithm::Diff::diff should fail (see BUG section of man page) on this one 102]; 103 104push @tests, [ # test conflict at end of sequences 105 [qw(a b c)], 106 [qw(a b d)], 107 [qw(a b e)], 108 [qw(a b < d | e >)], 109 [qw(a b < e | d >)], 110]; 111 112push @tests, [ 113 [qw(a b c e f h i k)], # ancestor 114 [qw(a b d e f g g i j k)], # left 115 [qw(a b c d e h i j k)], # right 116 [qw(a b d e g g i j k)] # merge 117]; 118 119push @tests, [ 120 [qw(a b c d h i j)], # ancestor 121 [qw(a b c d f h i j)], # left 122 [qw(a b c e g )], # right 123 [qw(a b c e f g )], # merge 124]; 125 126push @tests, [ 127 [qw(0 1 2 3 4 5 6 7 8 9)], 128 [qw(0 1 2 3 4 x 5 6 7 8 9)], 129 [qw(0 1 2 3 4 5 6 7 8 9)], 130 [qw(0 1 2 3 4 x 5 6 7 8 9)], 131]; 132 133push @tests, [ 134 [qw(0 1 2 6 7 8 x)], 135 [qw(0 1 2 4 6 7 8 x)], 136 [qw(0 1 3 5 x)], 137 [qw(0 1 3 4 5 x)] 138]; 139 140push @tests, [ 141 [qw(0 1 2 3 4 7 9 b)], 142 [qw(0 1 2 3 5 8 a b)], 143 [qw(0 6 8 a b)], 144 [qw(0 6 < 5 | > 8 a b)], 145 [qw(0 6 < | 5 > 8 a b)], 146]; 147 148push @tests, [ 149 [qw(1 3 4 5)], 150 [qw(1 a 3 4 5)], 151 [qw(1 b 3 4 5)], 152 [qw(1 < a | b > 3 4 5)], 153 [qw(1 < b | a > 3 4 5)], 154]; 155 156push @tests, [ 157 [qw(1 2 3 4 5 6 7)], 158 [qw(1 2 6 7)], 159 [qw(1 2 3 0 5 6 7)], 160 [qw(1 2 0 6 7)], 161 [qw(1 2 0 6 7)], 162]; 163 164$tests = scalar(@tests) + scalar(grep { !UNIVERSAL::isa($_, 'CODE') } @tests) + 1; 165 166#eval { require Algorithm::Diff }; 167#$tests *= -1 if $@; 168 169} 170 171use Test::More tests => $tests; 172 173require_ok('Algorithm::Merge'); 174 175my $out; 176 177foreach my $t (@tests) { 178 if(UNIVERSAL::isa($t, 'CODE')) { 179 eval { local $SIG{__DIE__}; $t -> (); }; 180 warn "$@\n" if $@ && $ENV{DEBUG}; 181 ok !$@; 182 } 183 else { 184 eval { 185 local $SIG{__DIE__}; 186 local $SIG{__WARN__} = sub { }; 187 $out = Algorithm::Merge::merge(@{$t}[0, 1, 2], 188 { 189 CONFLICT => sub ($$) { ( 190 q{<}, @{$_[0]}, q{|}, @{$_[1]}, q{>} 191 ) }, 192 }, 193 ); 194 }; 195 if($@ && $@ =~ m{^$error_message}o) { 196 ok 1; 197 } 198 else { 199 #my $diff = Algorithm::Diff::diff($out, $t -> [3]); 200 201 #warn "qw(", join(" ", @{$out}), ") ne qw(", join(" ", @{$t -> [3]}), ")\n" if $ENV{DEBUG} && @{$diff}; 202 #ok !@{$diff}; # ok if there's no difference 203 #main::diag("Expecting:\n" . join(" ", @{$t -> [3]}) . "\n" . join(" " , @{$out})); 204 is_deeply($out, $t -> [3]); 205 } 206 } 207} 208 209# make sure the merge is symmetric 210foreach my $t (@tests) { 211 next if UNIVERSAL::isa($t, 'CODE'); 212 eval { 213 local $SIG{__DIE__}; 214 local $SIG{__WARN__} = sub { }; 215 $out = Algorithm::Merge::merge(@{$t}[0, 2, 1], 216 { 217 CONFLICT => sub ($$) { ( 218 q{<}, @{$_[0]}, q{|}, @{$_[1]}, q{>} 219 ) }, 220 }, 221 ); 222 }; 223 224 if($@ && $@ =~ m{^$error_message}o) { 225 ok 1; 226 } 227 else { 228 my $diff = Algorithm::Diff::diff($out, $t -> [4] || $t -> [3]); 229 230 warn "qw(", join(" ", @{$out}), ") ne qw(", join(" ", @{$t -> [4] || $t -> [3]}), ")\n" if $ENV{DEBUG} && @{$diff}; 231 #ok !@{$diff}; # ok if there's no difference 232 is_deeply($out, $t -> [4] || $t -> [3]); 233 } 234} 235 236 237exit 0; 238 239