branch master updated: * Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm (_normalize_texinfo_name): adapt to tree structure change. Better error reporting in case of parser errors.

[Patrice Dumas]

This is an automated email from the git hooks/post-receive script.

pertusus pushed a commit to branch master
in repository texinfo.

The following commit(s) were added to refs/heads/master by this push:
     new a335297f11 * Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm 
(_normalize_texinfo_name): adapt to tree structure change. Better error 
reporting in case of parser errors.
a335297f11 is described below

commit a335297f1141964115e3450ce6988aa619eda421
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Mon Jan 3 12:16:48 2022 +0100

    * Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
    (_normalize_texinfo_name): adapt to tree structure change.
    Better error reporting in case of parser errors.
    
    * tp/Texinfo/Common.pm (protect_first_parenthesis): fail with
    backtrace if argument is undef.
---
 ChangeLog                                    |  9 +++++++++
 Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm | 26 ++++++++++++++++++++++----
 Pod-Simple-Texinfo/prove.sh                  |  2 +-
 tp/Texinfo/Common.pm                         | 21 ++++++++++++---------
 4 files changed, 44 insertions(+), 14 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 6297fe5052..b244de97d6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2022-01-03  Patrice Dumas  <pertusus@free.fr>
+
+       * Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
+       (_normalize_texinfo_name): adapt to tree structure change.
+       Better error reporting in case of parser errors.
+
+       * tp/Texinfo/Common.pm (protect_first_parenthesis): fail with
+       backtrace if argument is undef.
+
 2022-01-03  Patrice Dumas  <pertusus@free.fr>
 
        * tp/Texinfo/Convert/Texinfo.pm (convert_to_texinfo): use confess
diff --git a/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm 
b/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
index ef81ac74a1..34d0b954fc 100644
--- a/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
+++ b/Pod-Simple-Texinfo/lib/Pod/Simple/Texinfo.pm
@@ -327,11 +327,29 @@ sub _normalize_texinfo_name($$)
     }
     $texinfo_text = "\@$command $name\n";
   }
-  my $tree = parse_texi_text(undef, $texinfo_text);
+  my $parser = Texinfo::Parser::parser();
+  my $tree = $parser->parse_texi_text($texinfo_text);
+  if (!defined($tree)) {
+    my $texinfo_text_str = $texinfo_text;
+    chomp($texinfo_text_str);
+    warn "ERROR: Texinfo parsing failed for: $texinfo_text_str\n";
+    my $registrar = $parser->registered_errors();
+    my ($parser_errors, $parser_error_count) = $registrar->errors();
+    foreach my $error_message (@$parser_errors) {
+      if ($error_message->{'type'} eq 'error') {
+        warn "ERROR: $error_message->{'error_line'}";
+      } else {
+        warn "WARNING: $error_message->{'error_line'}";
+      }
+    }
+    # FIXME Or undef, and callers check the return to be defined?
+    return '';
+  }
+  # TODO this is dependent on the tree structure, this is not robust.
   if ($command eq 'anchor') {
-    #print STDERR "GGG $tree->{'contents'}->[0]->{'cmdname'}\n";
-    $tree->{'contents'}->[0]->{'args'}->[-0]->{'contents'}
-      = 
protect_first_parenthesis($tree->{'contents'}->[0]->{'args'}->[-0]->{'contents'});
+    #print STDERR "GGG 
$tree->{'contents'}->[0]->{'contents'}->[0]->{'cmdname'}\n";
+    $tree->{'contents'}->[0]->{'contents'}->[0]->{'args'}->[-0]->{'contents'}
+      = 
protect_first_parenthesis($tree->{'contents'}->[0]->{'contents'}->[0]->{'args'}->[-0]->{'contents'});
   }
   my $fixed_text = Texinfo::Convert::Texinfo::convert_to_texinfo($tree, 1);
   my $result = $fixed_text;
diff --git a/Pod-Simple-Texinfo/prove.sh b/Pod-Simple-Texinfo/prove.sh
index d9fdad139b..988cef5aeb 100755
--- a/Pod-Simple-Texinfo/prove.sh
+++ b/Pod-Simple-Texinfo/prove.sh
@@ -12,7 +12,7 @@ fi
 #prove -I "$tpdir" -I "$srcdir"/lib "$srcdir"/t/*.t
 
 tpdir=$srcdir/../tp
-prove -I "$tpdir" -I "$tpdir"/maintain/lib/Unicode-EastAsianWidth/lib/ \
+prove -w -I "$tpdir" -I "$tpdir"/maintain/lib/Unicode-EastAsianWidth/lib/ \
       -I "$tpdir"/maintain/lib/libintl-perl/lib \
       -I "$tpdir"/maintain/lib/Text-Unidecode/lib/ \
       -I "$srcdir"/lib \
diff --git a/tp/Texinfo/Common.pm b/tp/Texinfo/Common.pm
index 7343a4d995..9b6ad3b56d 100644
--- a/tp/Texinfo/Common.pm
+++ b/tp/Texinfo/Common.pm
@@ -33,7 +33,7 @@ use Encode;
 use Texinfo::Documentlanguages;
 
 # debugging
-use Carp qw(cluck);
+use Carp qw(cluck confess);
 
 require Exporter;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -2226,7 +2226,7 @@ sub _protect_text($$)
   my $current = shift;
   my $to_protect = shift;
 
-  #print STDERR "$to_protect: $current ".debug_print_element($current)."\n";
+  #print STDERR "_protect_text: $to_protect: $current 
".debug_print_element($current)."\n";
   if (defined($current->{'text'}) and $current->{'text'} =~ /$to_protect/
       and !(defined($current->{'type'}) and $current->{'type'} eq 'raw')) {
     my @result = ();
@@ -2254,10 +2254,10 @@ sub _protect_text($$)
         last;
       }
     }
-    #print STDERR "Result: @result\n";
+    #print STDERR "_protect_text: Result: @result\n";
     return @result;
   } else {
-    #print STDERR "No change: $current\n";
+    #print STDERR "_protect_text: No change\n";
     return ($current);
   }
 }
@@ -2267,7 +2267,7 @@ sub _protect_colon($$)
   my $type = shift;
   my $current = shift;
 
-  return _protect_text ($current, quotemeta(':'));
+  return _protect_text($current, quotemeta(':'));
 }
 
 sub protect_colon_in_tree($)
@@ -2281,7 +2281,7 @@ sub _protect_node_after_label($$)
   my $type = shift;
   my $current = shift;
 
-  return _protect_text ($current, '['. quotemeta(".\t,") .']');
+  return _protect_text($current, '['. quotemeta(".\t,") .']');
 }
 
 sub protect_node_after_label_in_tree($)
@@ -2293,7 +2293,9 @@ sub protect_node_after_label_in_tree($)
 sub protect_first_parenthesis($)
 {
   my $contents = shift;
-  return undef if (!defined ($contents));
+  confess("BUG: protect_first_parenthesis contents undef")
+    if (!defined($contents));
+  #print STDERR "protect_first_parenthesis: $contents\n";
   my @contents = @$contents;
   my $brace;
   if ($contents[0] and $contents->[0]{'text'} and $contents[0]->{'text'} =~ 
/^\(/) {
@@ -2920,10 +2922,11 @@ in C<@asis{}>.
 
 Protect comma characters, replacing C<,> with @comma{} in tree.
 
-=item $contents_result = protect_first_parenthesis ($contents)
+=item $contents_result = protect_first_parenthesis($contents)
 
 Return a contents array reference with first parenthesis in the
-contents array reference protected.
+contents array reference protected.  If I<$contents> is undef
+a fatal error with a backtrace will be emitted.
 
 =item protect_hashchar_at_line_beginning($registrar, 
$configuration_informations, $tree)