Subject: | substr loses tags that extend beyond the substring |
Attached: test case and patch.
Subject: | substr.patch |
diff --git i/lib/String/Tagged.pm w/lib/String/Tagged.pm
index f2acc88..37a10e8 100644
--- i/lib/String/Tagged.pm
+++ w/lib/String/Tagged.pm
@@ -340,7 +340,7 @@ sub substr
$ts = -1 if $ts < 0 or $tf & FLAG_ANCHOR_BEFORE;
$te = -1 if $te > $end or $tf & FLAG_ANCHOR_AFTER;
- $ret->apply_tag( $ts, $te - $ts, $tn => $tv );
+ $ret->apply_tag( $ts, ($te<0 ? $te : $te - $ts), $tn => $tv );
}
return $ret;
Subject: | substr.t |
#!perl
use strict;
use warnings;
use Test::More;
use Test::Deep;
use String::Tagged;
sub check_extent {
my ($str,$anchored) = @_;
my $e = $str->get_tag_extent(0,'v');
ok($e,'the tag should be there');
cmp_deeply(
$e,
methods(
plain_substr => 'b',
start => 0,
end => 1,
anchor_before => bool($anchored),
anchor_after => bool($anchored),
),
'the tag should '.($anchored?'':'not ').'extend beyond the substr',
);
}
subtest 'not anchored' => sub {
my $str = String::Tagged->new('abcd');
$str->apply_tag(1,1,v=>1);
check_extent($str->substr(1,1),0);
};
subtest anchored => sub {
my $str = String::Tagged->new_tagged('abcd',v=>1);
check_extent($str->substr(1,1),1);
};
done_testing;