sub is_string ($) { $_[0]{T} =~ m/heredoc|string/; }
sub is_trans ($) { grep { $_[0]{E} eq $_ } qw(__ f_ i_); }
+sub qp ($) {
+ my ($p) = @_;
+ $p =~ s{\\}{\\\\}g;
+ $p =~ s{\'}{\\'}g;
+ $p =~ s{\n}{\\n}g;
+ $p =~ s{\t}{\\t}g;
+ return "'$p'";
+};
+
sub semiparse ($) {
($_) = @_;
my @o;
push @o, { T => 'heredoc', Q => $q, Delim => $d,
E => $&, P => "<<$q$d$q" };
s{^
- ( .* \n )
- ( (?: (?! $d) .* \n )* )
- $d \n
+ ( .* \n )
+ ( (?: (?! $d \n ) .* \n )*? )
+ $d \n
}{ $1 }xe or die "missing end of here doc $d\n";
$o[$#o]{V} = $2;
} elsif (s{^ (["'])( (?: [^\\'"]
my ($lit, $what) = @_;
my $xl = substr($xs, 0, length($lit));
if ($xl ne $lit) {
- my $q = sub {
- my ($p) = @_;
- $p =~ s{\\}{\\\\}g;
- $p =~ s{\'}{\\'}g;
- $p =~ s{\n}{\\n}g;
- $p =~ s{\t}{\\t}g;
- return "'$p'";
- };
- debug $ichunkstart, "not exactly x: ..".$q->($xs);
- debug $ichunkstart, "not exactly y: ".$q->($lit);
+ debug $ichunkstart, "not exactly x: ..".qp($xs);
+ debug $ichunkstart, "not exactly y: ".qp($lit);
my $next = @ys ? $ys[0]{P} : '(end)';
die "string contents mismatch near $what before $next\n";
}
if ($fmt !~ m{\%[^\%]}) {
$exactly->($fmt, '(tail)');
$fmt = '';
- die "text deleted from end of string\n" if length $xs;
+ die "text deleted from end of string: ".qp($xs)."\n"
+ if length $xs;
last;
}
$exactly->($`, '(literal)');