The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use 5.010;
use strict;
use warnings;
use FindBin '$Bin';
use lib $Bin, "$Bin/t";

use Text::Fragment qw(delete_fragment);
use Test::More 0.98;

test_delete_fragment(
    name          => "one-line/shell, noop",
    args          => {text=>"1\n2\n3\n", id=>"id1"},
    status        => 304,
);
test_delete_fragment(
    name          => "one-line/shell, noop 2",
    args          => {text=>"1\n2\n3\nx # FRAGMENT id=id1\n", id=>"i"},
    text          => "1\n2\n3\n",
    status        => 304,
);
test_delete_fragment(
    name          => "one-line/shell",
    args          => {text=>"1\n2\n3\nx # FRAGMENT id=id1\n", id=>"id1"},
    text          => "1\n2\n3\n",
    orig_payload  => "x",
    orig_fragment => "x # FRAGMENT id=id1\n",
);
test_delete_fragment(
    name          => "one-line/shell, no ending newline",
    args          => {text=>"1\n2\n3\nx # FRAGMENT id=id1", id=>"id1"},
    text          => "1\n2\n3",
    orig_payload  => "x",
    orig_fragment => "x # FRAGMENT id=id1",
);
test_delete_fragment(
    name          => "one-line/shell, no ending newline, beginning",
    args          => {text=>"x # FRAGMENT id=id1", id=>"id1"},
    text          => "",
    orig_payload  => "x",
    orig_fragment => "x # FRAGMENT id=id1",
);
test_delete_fragment(
    name          => "multiline/shell, no ending newline",
    args          => {text=>"1\n# BEGIN FRAGMENT id=id1\nx\n# END FRAGMENT",
                      id=>"id1"},
    text          => "1",
    orig_payload  => "x\n",
    orig_fragment => "# BEGIN FRAGMENT id=id1\nx\n# END FRAGMENT",
);
test_delete_fragment(
    name          => "multiline/shell, no ending newline, beginning",
    args          => {text=>"# BEGIN FRAGMENT id=id1\nx\n# END FRAGMENT",
                      id=>"id1"},
    text          => "",
    orig_payload  => "x\n",
    orig_fragment => "# BEGIN FRAGMENT id=id1\nx\n# END FRAGMENT",
);
test_delete_fragment(
    name          => "multiline/cpp, multiple fragments",
    args          => {text=><<'_', id=>"id1", comment_style=>"cpp"},
1
// BEGIN FRAGMENT id=id1
x
y
// END FRAGMENT id=id1
2
// BEGIN FRAGMENT id=id2
a
b
// END FRAGMENT id=id2
c // FRAGMENT id=id3
_
    text          => <<'_',
1
2
// BEGIN FRAGMENT id=id2
a
b
// END FRAGMENT id=id2
c // FRAGMENT id=id3
_
    orig_payload  => "x\ny\n",
    orig_fragment => <<'_',
// BEGIN FRAGMENT id=id1
x
y
// END FRAGMENT id=id1
_
);
test_delete_fragment(
    name          => "one-line/c, multiple occurences",
    args          => {text=><<_, id=>"id1", comment_style=>"c"},
1
x1 /* FRAGMENT id=id1 */
2
3
 x2  /* FRAGMENT id=id1 */
_
    text          => <<'_',
1
2
3
_
    orig_payload  => " x2",
    orig_fragment => " x2  /* FRAGMENT id=id1 */\n",
);

DONE_TESTING:
done_testing;

sub test_delete_fragment {
    my %targs = @_;

    subtest $targs{name} => sub {
        my $res = delete_fragment(%{ $targs{args} });
        my $status = $targs{status} // 200;
        is($res->[0], $status, 'status');
        return if $status != 200;
        for (qw/text orig_payload orig_fragment/) {
            if (defined $targs{$_}) {
                is($res->[2]{$_}, $targs{$_}, $_);
            }
        }
    };
}