chiark / gitweb /
auditor wip
[dgit-junk.git] / i18n-diff-auditor
index 42190417d7da5ba2f0c1365b8d40956e8b8d0027..f8528d97d1e26b430b4cb43eb382172a276ebe75 100755 (executable)
@@ -107,8 +107,9 @@ sub semiparse ($) {
        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{^
@@ -123,19 +124,19 @@ sub semiparse ($) {
                               )*
                        \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 {
@@ -157,21 +158,23 @@ sub analyse_chunk_core () {
        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};
@@ -179,13 +182,13 @@ sub analyse_chunk_core () {
            };
            $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;
@@ -205,31 +208,32 @@ sub analyse_chunk_core () {
                }
                $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 ':') {
@@ -240,18 +244,8 @@ sub analyse_chunk_core () {
            }
            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 () {