X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=i18n-diff-auditor;h=363103fccf01e7a4f7bfc47894330d6c56fe2066;hp=b85b853687e3ad95065615bc8f702d49f3ddab2b;hb=6090adb68f0ab2b79adba51212bfe7b2dff0e6df;hpb=ff167d2d9dc9076a8553771f43e28a5a96e412c6

diff --git a/i18n-diff-auditor b/i18n-diff-auditor
index b85b8536..363103fc 100755
--- a/i18n-diff-auditor
+++ b/i18n-diff-auditor
@@ -1,4 +1,22 @@
 #!/usr/bin/perl -w
+#
+# i18n-diff-auditor
+# Copyright (C)2018 Ian Jackson
+# GPLv3+, NO WARRANTY, see below.
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
 use strict;
 use Carp;
 use Data::Dumper;
@@ -110,9 +128,19 @@ our ($before, $after);
 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;
+    #my $in = $_;
     # entries contain
     #   T     type
     #   E     exact input text (does not contain here doc contents)
@@ -128,12 +156,18 @@ sub semiparse ($) {
 	    $q ||= '"';
 	    push @o, { T => 'heredoc', Q => $q, Delim => $d,
 		       E => $&, P => "<<$q$d$q" };
-	    s{^
-                (             .* \n    )
-                ( (?: (?! $d) .* \n )* )
-                          $d     \n
-              }{ $1 }x or die "missing end of here doc $d\n";
-	    $o[$#o]{V} = $2;
+	    if (s{^
+		    (                 .* \n     )
+		    ( (?: (?! $d \n ) .* \n )*? )
+			      $d         \n
+	         }{ $1 }xe) {
+		$o[$#o]{V} = $2;
+            } else {
+		m{^.*\n} or confess;
+		$_ = $&;
+		$o[$#o]{V} = $';
+		$o[$#o]{Invented} = 1;
+	    }
 	} elsif (s{^ (["'])( (?: [^\\'"]
                                | \\ [^"']
                                | (?! \1 ) [^"]
@@ -167,6 +201,7 @@ sub semiparse ($) {
 	next if grep { !is_string($_) } @inputs;
 	my $q = $inputs[0]{Q};
 	next if grep { $_->{Q} ne $q } @inputs;
+	next if grep { $_->{Invented} } @inputs;
 	my $new = { T => 'joinedstrings',
 		    E => (join '.', map { $_->{E} } @inputs),
 		    P => (join '.', map { $_->{P} } @inputs),
@@ -177,6 +212,7 @@ sub semiparse ($) {
 	$i--; # counteracts $i++
     }
     debug $ichunkstart, "semiparsed: ".join ' ', map { $_->{P} } @o;
+    # debug $ichunkstart, "semiparsed V: ".join ' ', map { defined $_->{V} ? ">$_->{V}<" : '-' } @o;
     return @o;
 }	    
 
@@ -212,12 +248,21 @@ sub analyse_chunk_core () {
 	next if $x->{E} eq $y->{E};
 	next if $x->{E} eq 'sprintf' and $y->{E} eq 'f_';
 	next if $x->{E} eq 'die'     and $y->{E} eq 'confess';
+	next if $x->{E} eq 'die'     and $y->{E} eq 'fail';
 	if ($y->{E} eq '+'
 	    and @ys >= 3
 	    and $ys[0]{E} eq '('
 	    and is_trans($ys[1])) {
 	    $next_y->(); # (
-	    $next_y->(); # __ f_
+	    $next_y->(); # __ f_ i_
+	    @y_expect_suffix = ')';
+	} elsif ($y->{E} eq '('
+	    and @ys > 2
+	    and is_trans($ys[0])
+	    and @analysed_y
+	    and (grep { $_ eq $analysed_y[-1] } (qw( => [ { ? : . ),
+						 '(', ',') )) {
+	    $next_y->(); # __ f_ i_
 	    @y_expect_suffix = ')';
 	}
 	my $string_changed;
@@ -225,7 +270,7 @@ sub analyse_chunk_core () {
 	if (is_trans($y)) {
 	    $next_y->();
 	    die "__ on non-string $y->{P}\n"     unless is_string($y);
-	    die "__ on was non-string $y->{P}\n" unless is_string($x);
+	    die "__ on was non-string $x->{P}\n" unless is_string($x);
 	    if ($y->{Q} ne "'") {
 		die "var subst in new string\n"
 		    if $y->{V} =~ m{(?<!\\) [\$\@]};
@@ -248,7 +293,7 @@ sub analyse_chunk_core () {
 	}
 	if ($ye eq 'f_') {
 	    my $fmt = $y->{V};
-	    die "no percent in _f string\n" unless $fmt =~ m{\%};
+	    die "no percent in f_ string\n" unless $fmt =~ m{\%};
 	    next unless $string_changed;
 	    die "f_ old string '-quoted\n" if $x->{Q} ne '"';
 	    my $xs = $x->{V};
@@ -256,17 +301,20 @@ sub analyse_chunk_core () {
 		my ($lit, $what) = @_;
 		my $xl = substr($xs, 0, length($lit));
 		if ($xl ne $lit) {
-		    debug $ichunkstart, "not exactly x: \"..$xs\"";
-		    debug $ichunkstart, "not exactly y:   $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";
 		}
 		$xs = substr($xs, length($lit));
 	    };
 	    for (;;) {
+		#print STDERR Dumper($fmt, $xs, \@xs, @ys);
 		if ($fmt !~ m{\%[^\%]}) {
 		    $exactly->($fmt, '(tail)');
 		    $fmt = '';
+		    die "text deleted from end of string: ".qp($xs)."\n"
+			if length $xs;
 		    last;
 		}
 		$exactly->($`, '(literal)');
@@ -335,6 +383,8 @@ sub analyse_chunk () {
 	return unless length $@;
 	if ($@ =~ m{^missing end of here doc (\S+)\n}) {
 	    # fudge this
+	    # (this never happens now, but in the future we might
+	    # want this code again eg to try adding to the chunk)
 	    $before .= "\n$1\n";
 	    $after .= "\n$1\n";
 	    next;