i18n: i18n-diff-auditor: improve debug output

[dgit.git] / i18n-diff-auditor

diff --git a/i18n-diff-auditor b/i18n-diff-auditor
index f40c8e97e7ec0f94685b76c55815df04f248f46f..6f9dab51a53c1c9c189ad5cafe19b02c1a21ac5c 100755 (executable)
--- a/i18n-diff-auditor
+++ b/i18n-diff-auditor
@@ -139,7 +139,7 @@ sub semiparse ($) {
                               )*
                        ) \1 }{}x) {
            my ($q,$v) = ($1,$2);
-           push @o, { T => 'string', E => $&, P => "$q-string",
+           push @o, { T => 'string', E => $&, P => "$q$q",
                       Q => $q, V => $v};
        } elsif (s{^$perlop_re|^\;}{}) {
            push @o, { T => 'op', E => $&, P => $& };
@@ -178,24 +178,44 @@ sub semiparse ($) {
     return @o;
 }          
 
+our @analysed_x;
+our @analysed_y;
+
 sub analyse_chunk_core () {
     die "plain deletion\n" unless defined $after;
     die "plain insertion\n" unless defined $before;
     my @xs = semiparse $before;
     my @ys = semiparse $after;
+    @analysed_x = @analysed_y = ();
     my $next_something = sub {
-       my ($ary,$var,$what) = @_;
+       my ($ary,$anal,$var,$what) = @_;
        die "ran out of $what\n" unless @$ary;
-       $$var = shift @$ary;
+       my $r = shift @$ary;
+       push @$anal, $r->{P};
+       $$var = $r;
     };
     my ($x,$y);
-    my $next_x = sub { $next_something->(\@xs, \$x, 'before'); };
-    my $next_y = sub { $next_something->(\@ys, \$y, 'after' ); };
+    my $next_x = sub { $next_something->(\@xs, \@analysed_x, \$x, 'before'); };
+    my $next_y = sub { $next_something->(\@ys, \@analysed_y, \$y, 'after' ); };
+    our @y_expect_suffix = ();
     for (;;) {
+       while (my $e = shift @y_expect_suffix) {
+           $next_y->();
+           $y->{E} eq $e
+               or die "suffix mismatch, expected $e got $y->{E}\n";
+       }
        last unless @xs or @ys;
        $next_x->();
        $next_y->();
        next if $x->{E} eq $y->{E};
+       if ($y->{E} eq '+'
+           and @ys >= 3
+           and $ys[0]{E} eq '('
+           and ($ys[1]{E} eq '__' or $ys[2]{E} eq 'f_')) {
+           $next_y->(); # (
+           $next_y->(); # __ f_
+           @y_expect_suffix = ')';
+       }
        my $string_changed;
        my $ye = $y->{E};
        if ($ye eq '__' or $ye eq 'f_') {
@@ -228,8 +248,8 @@ sub analyse_chunk_core () {
                my ($lit, $what) = @_;
                my $xl = substr($xs, 0, length($lit));
                if ($xl ne $lit) {
-                   debug $ichunkstart, "not exactly x: $xl";
-                   debug $ichunkstart, "not exactly y: $lit";
+                   debug $ichunkstart, "not exactly x: ..\"$xs\"";
+                   debug $ichunkstart, "not exactly y:    $lit";
                    my $next = @ys ? $ys[0]{P} : '(end)';
                    die "string contents mismatch near $what before $next\n";
                }
@@ -261,14 +281,18 @@ sub analyse_chunk_core () {
                    }
                    $next_y->();
                    if (!$bras and
-                       (grep { $y->{E} eq $_ } qw( or xor and not ; : )
+                       (grep { $y->{E} eq $_ } qw( or xor and not ; :
+                                                   if unless while when )
+                        or $y->{E} eq ','
                         or $y->{T} eq 'ket'
                        )) {
+                       # lookahead shows close of containing scope
+                       # or lower precedence operator
                        unshift @ys, $y;
+                       pop @analysed_y;
                        last;
                    }
                    $xs =~ s{^\s+}{};
-                   #debug $ichunkstart, "TOKEN $y->{P}\n";
                    $exactly->($y->{E}, $y->{P});
                    if ($y->{T} eq 'bra' or $y->{E} eq '?') {
                        $bras++;
@@ -359,6 +383,8 @@ for ($ifilehead = 0; l_ok $ifilehead; $ifilehead++) {
                    $ichunkend = $i;
                    eval { analyse_chunk(); 1; };
                    if (length $@) {
+                       debug $ichunkstart, "done x: @analysed_x";
+                       debug $ichunkstart, "done y: @analysed_y";
                        push @report, { M => $@,
                                        S => $ichunkstart,
                                        E => $ichunkend };