s{^\s+}{};
if (s{^[\$\@\%]?[_0-9a-zA-Z]+}{}) {
push @o, { T => 'ident', E => $&, P => $& };
- } elsif (s{^\<\<('?)([A-Z_]+)\1}{}) {
+ } elsif (s{^\<\<(['"]?)([A-Z_]+)\1}{}) {
my ($q,$d) = ($1,$2);
+ $q //= '"';
push @o, { T => 'heredoc', Q => $q, Delim => $d,
E => $&, P => "<<$q$d..." };
s{^
)*
\1 )}{}x) {
my ($q,$v) = ($1,$2);
- push @o, { T => 'string', Q => $q, V => $v,
- I => $&, P => "$q-string" };
+ push @o, { T => 'string', E => $&, P => "$q-string",
+ Q => $q, V => $v};
} elsif (s{^$perlop_re|\;}{}) {
- push @o, { T => 'op', E => $&, I => $& };
+ push @o, { T => 'op', E => $&, P => $& };
} elsif (s/[[{(]//) {
- push @o, { T => 'bra', E => $&, I => $& };
+ push @o, { T => 'bra', E => $&, P => $& };
} elsif (s/[]})]//) {
- push @o, { T => 'ket', E => $&, I => $& };
+ push @o, { T => 'ket', E => $&, P => $& };
} elsif (s/^( [\$\@\%] )( \{ )//x) {
- push @o, { T => 'deref', E => $1, I => $1 },
- { T => 'bra', E => $2, I => $1 };
+ push @o, { T => 'deref', E => $1, P => $1 },
+ { T => 'bra', E => $2, P => $2 };
} elsif (s/^ [\$\@\%] [^[^{] //x) {
- push @o, { T => 'specvar', E => $&, I => $& };
+ push @o, { T => 'specvar', E => $&, P => $& };
} elsif (!length) {
last;
} else {
die "ran out of $what\n" unless @$ary;
$$var = shift @$ary;
};
+ my ($x,$y);
my $next_before = sub { $next_something->(\@before, \$x, 'before'); };
my $next_after = sub { $next_something->(\@after , \$y, 'after' ); };
- sub $is_string = sub { $_[0]{T} =~ m/heredoc|string/; };
+ my $is_string = sub { $_[0]{T} =~ m/heredoc|string/; };
for (;;) {
last unless @before or @after;
$next_before->();
$next_after->();
- next if $x->{I} eq $y->{I};
+ next if $x->{E} eq $y->{E};
my $string_changed;
- if ($y->{I} eq '__' or $y->{I} eq '_f') {
+ if ($y->{E} eq '__' or $y->{E} eq '_f') {
$next_after->();
- die "__ on non-string\n" unless Sis_string($y);
- die "__ on was non-string\n" unless $is_string($x);
+ die "__ on non-string $y->{P}\n" unless Sis_string->($y);
+ die "__ on was non-string $y->{P}\n" unless $is_string->($x);
if ($y->{Q} ne "'") {
- die "var subst in new str\n" if $y->{V} =~ m{(?<!\\) [\$\@]};
+ die "var subst in new string\n"
+ if $y->{V} =~ m{(?<!\\) [\$\@]};
}
eval {
die "__ string changed\n" unless $y->{V} eq $x->{V};
};
$string_changed = $@;
}
- if ($y->{I} eq '__') {
+ if ($y->{E} eq '__') {
$_ = $y->{V};
- die "percent in __ ' string\n" if m{\%};
- die $string_changed if length $not_unchanged;
+ die "percent $& in __ ' string\n" if m{\%};
+ die $string_changed if length $string_changed;
next;
}
- if ($y->{I} eq 'f_') {
+ if ($y->{E} eq 'f_') {
my $fmt = $y->{V};
die "no percent in _f string\n" unless $fmt =~ m{\%};
next unless $string_changed;
}
$exactly->($`);
$fmt = $';
- if ($& eq '%%') { $exactly('%'); next; }
+ if ($& eq '%%') { $exactly->('%'); next; }
elsif ($& ne '%s') { die "unhandled %-subst $&\n"; }
$next_after->();
- die "expected comma, got $y->{T}\n" unless $y->{I} eq ',';
- if ($old =~ m{^\@}) {
+ die "expected comma, got $y->{P}\n" unless $y->{E} eq ',';
+ if ($xs =~ m{^\@}) {
$next_after->();
- die "\@... => not string" unless $is_string($y);
+ die "\@... => not string" unless $is_string->($y);
+ die "\@... => $y->{P}" if $y->{Q} ne '"';
$exactly->($y->{V});
next;
}
my $bras = 0;
for (;;) {
- if (!$bra and !@after) {
+ if (!$bras and !@after) {
last;
}
$next_after->();
- if (!$bra and
- (grep { $y->{I} eq $_ } qw( or xor and not ; : )
+ if (!$bras and
+ (grep { $y->{E} eq $_ } qw( or xor and not ; : )
or $y->{T} eq 'ket'
)) {
- unshift @after, $ys;
+ unshift @after, $y;
last;
}
$xs =~ s{^\s+}{};
- $exactly->{$y->{I});
+ $exactly->($y->{E});
if ($y->{T} eq 'bra' or $y->{L} eq '?') {
$bras++;
} elsif ($y->{T} eq 'ket' or $y->{L} eq ':') {
}
next;
}
- die "mismatch
-
- $exact->
-
- if ($fmt =~ m{
- if
-
- if ($y->{Q} eq $x->{Q} && $y->
-
- $y = shift @after;
- print Dumper($ichunkstart, $ichunkend, \@before, \@after);
- flush STDOUT;
+ die "mismatch $x->{P} => $y->{P}\n";
+ }
}
sub analyse_chunk () {