| 1 |
use common::sense; |
| 2 |
use Test::More; |
| 3 |
use AnyEvent (); |
| 4 |
use AnyEvent::MCP (); |
| 5 |
use File::Temp qw(tempdir); |
| 6 |
|
| 7 |
my $log = "Hmm... Looks like a unified diff to me...\n" |
| 8 |
. "The text leading up to this was:\n--------------------------\n|--- a/input\n|+++ b/input\n" |
| 9 |
. "--------------------------\npatching file output (read from input)\n" |
| 10 |
. "Hunk #1 succeeded at 2 (offset -1 line).\n" |
| 11 |
. "Hunk #2 succeeded at 8 with fuzz 2 (offset 3 lines).\ndone\n"; |
| 12 |
my $parsed = AnyEvent::MCP::parse_patch_output $log; |
| 13 |
is_deeply $parsed, { |
| 14 |
hunks => [ |
| 15 |
{ hunk => 1, success => 1, line => 2, fuzz => 0, offset => -1 }, |
| 16 |
{ hunk => 2, success => 1, line => 8, fuzz => 2, offset => 3 }, |
| 17 |
], |
| 18 |
unparsed => [], |
| 19 |
}, "parse verbose framing, signed offsets and fuzz"; |
| 20 |
|
| 21 |
$parsed = AnyEvent::MCP::parse_patch_output ( |
| 22 |
"Hunk #1 FAILED at 4.\nHunk #2 ignored at 7.\nunexpected diagnostic\n" |
| 23 |
); |
| 24 |
ok !$parsed->{hunks}[0]{success} && !$parsed->{hunks}[1]{success}, "parse failed and ignored hunks"; |
| 25 |
is_deeply $parsed->{unparsed}, ["unexpected diagnostic"], "retain unknown diagnostics"; |
| 26 |
|
| 27 |
for my $offset (-2, 0, 2) { |
| 28 |
my $hunks = AnyEvent::MCP::check_patch_output ( |
| 29 |
0, "Hunk #1 succeeded at 10 (offset $offset lines).\n", [2] |
| 30 |
); |
| 31 |
is $hunks->[0]{offset}, $offset, "accept offset inside limit"; |
| 32 |
} |
| 33 |
|
| 34 |
for my $case ( |
| 35 |
[256, "Hunk #1 succeeded at 1.\n", [0], qr/wait status 256/], |
| 36 |
[9, "", [0], qr/wait status 9/], |
| 37 |
[0, "Hunk #1 succeeded at 1.\nunexpected\n", [0], qr/unrecognized output/], |
| 38 |
[0, "", [0], qr/expected 1 hunks, got 0/], |
| 39 |
[0, "", [], qr/expected 0 hunks, got 0/], |
| 40 |
[0, "Hunk #1 succeeded at 1.\n", [0, 0], qr/expected 2 hunks, got 1/], |
| 41 |
[0, "Hunk #2 succeeded at 1.\n", [0], qr/unexpected hunk number/], |
| 42 |
[0, "Hunk #1 succeeded at 1.\nHunk #1 succeeded at 2.\n", [0, 0], qr/unexpected hunk number/], |
| 43 |
[0, "Hunk #1 FAILED at 1.\n", [0], qr/hunk 1 failed/], |
| 44 |
[0, "Hunk #1 succeeded at 1 with fuzz 1.\n", [0], qr/used fuzz/], |
| 45 |
[0, "Hunk #1 succeeded at 1 (offset 3 lines).\n", [2], qr/exceeds 2/], |
| 46 |
[0, "Hunk #1 succeeded at 1 (offset -3 lines).\n", [2], qr/exceeds 2/], |
| 47 |
) { |
| 48 |
eval { AnyEvent::MCP::check_patch_output @$case[0, 1, 2] }; |
| 49 |
like $@, $case->[3], "reject incomplete or unacceptable application"; |
| 50 |
} |
| 51 |
|
| 52 |
my $dir = tempdir CLEANUP => 1; |
| 53 |
my $input = "$dir/input"; |
| 54 |
my $source = "zero\none\ntwo\nthree\n"; |
| 55 |
open my $fh, ">", $input or die $!; |
| 56 |
print $fh $source; |
| 57 |
close $fh or die $!; |
| 58 |
|
| 59 |
sub contents { |
| 60 |
open my $fh, "<", $_[0] or die "$_[0]: $!"; |
| 61 |
binmode $fh; |
| 62 |
local $/; |
| 63 |
<$fh> |
| 64 |
} |
| 65 |
|
| 66 |
my $output = "$dir/output"; |
| 67 |
my $diff = "--- a/input\n+++ b/input\n@@ -3 @@\n one\n-two\n+TWO\n three\n"; |
| 68 |
my $bad = "$dir/bad"; |
| 69 |
SKIP: { |
| 70 |
skip "extended GNU patch tests (PERL_ANYEVENT_MCP_TESTS=1)", 14 |
| 71 |
unless ($ENV{PERL_ANYEVENT_MCP_TESTS} || 0) >= 1; |
| 72 |
my ($patch) = grep -f && -x _, map "$_/patch", split /:/, $ENV{PATH}; |
| 73 |
skip "GNU patch is unavailable", 14 unless $patch; |
| 74 |
open my $version, "-|", $patch, "--version" or die "$patch: $!"; |
| 75 |
my $gnu = do { local $/; <$version> } =~ /GNU patch/; |
| 76 |
skip "GNU patch is unavailable", 14 unless close $version && $gnu; |
| 77 |
|
| 78 |
my $hunks = AnyEvent::MCP::apply_udiff ($input, $output, $diff)->recv; |
| 79 |
is contents ($output), "zero\none\nTWO\nthree\n", "real patch output"; |
| 80 |
is contents ($input), $source, "input unchanged"; |
| 81 |
is $hunks->[0]{offset}, -1, "real verbose offset validated"; |
| 82 |
|
| 83 |
eval { AnyEvent::MCP::apply_udiff ($input, $output, $diff) }; |
| 84 |
like $@, qr/\Q$output\E:/, "existing output refused"; |
| 85 |
is contents ($output), "zero\none\nTWO\nthree\n", "existing output preserved"; |
| 86 |
|
| 87 |
eval { AnyEvent::MCP::apply_udiff ($input, $bad, "@@ -3 @@\n-one\n+ONE\n")->recv }; |
| 88 |
like $@, qr/offset -1 exceeds 0/, "real excessive relocation rejected"; |
| 89 |
ok !-e $bad, "excessive-offset output removed"; |
| 90 |
|
| 91 |
eval { AnyEvent::MCP::apply_udiff ($input, $bad, $diff . "@@ -4 @@\n-absent\n+bad\n")->recv }; |
| 92 |
like $@, qr/patch failed/, "real partial application rejected"; |
| 93 |
ok !-e $bad, "partial output removed"; |
| 94 |
is contents ($input), $source, "input unchanged after failures"; |
| 95 |
|
| 96 |
eval { AnyEvent::MCP::apply_udiff ("$dir/missing", $bad, $diff)->recv }; |
| 97 |
like $@, qr/patch failed/, "missing input rejected"; |
| 98 |
ok !-e $bad, "output removed after command failure"; |
| 99 |
|
| 100 |
open my $binary, ">", "$dir/binary" or die $!; |
| 101 |
binmode $binary; |
| 102 |
print {$binary} "a\0\xff\n"; |
| 103 |
close $binary or die $!; |
| 104 |
AnyEvent::MCP::apply_udiff ("$dir/binary", "$dir/binary-output", |
| 105 |
"@@ -1 @@\n-a\0\xff\n+b\0\xfe\n")->recv; |
| 106 |
is contents ("$dir/binary-output"), "b\0\xfe\n", "byte diff preserves NUL and non-UTF-8 bytes"; |
| 107 |
is contents ("$dir/binary"), "a\0\xff\n", "binary patch leaves input unchanged"; |
| 108 |
|
| 109 |
} |
| 110 |
|
| 111 |
eval { AnyEvent::MCP::apply_udiff ($input, $bad, "invalid") }; |
| 112 |
like $@, qr/no hunks/, "invalid diff rejected before starting"; |
| 113 |
ok !-e $bad, "invalid diff creates no output"; |
| 114 |
|
| 115 |
done_testing; |
