texinfo/tp Texinfo/Parser.pm t/test_utils.pl

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        10/09/27 20:18:58

Modified files:
        tp/Texinfo     : Parser.pm 
        tp/t           : test_utils.pl 

Log message:
        Simplify error handling.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Parser.pm?cvsroot=texinfo&r1=1.22&r2=1.23
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_utils.pl?cvsroot=texinfo&r1=1.11&r2=1.12

Patches:
Index: Texinfo/Parser.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Parser.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- Texinfo/Parser.pm   27 Sep 2010 07:33:47 -0000      1.22
+++ Texinfo/Parser.pm   27 Sep 2010 20:18:58 -0000      1.23
@@ -41,7 +41,6 @@
   tree_to_texi      
   parse_texi_text
   parse_texi_line
-  tree
   errors
 ) ] );
 
@@ -65,10 +64,6 @@
 }
 
 my %default_configuration = (
-  'error' => 'generate', # the contrary could be 'return'
-  'force' => 0,
-  'no_warn' => 0,
-  'error_limit' => 100,
   'test' => 0,
   'debug' => 0,
   'gettext' => sub {return $_[0];},
@@ -322,7 +317,6 @@
 }
 
 
-
 $block_commands{'float'} = 2;
 
 my %item_container_commands;
@@ -426,7 +420,6 @@
 foreach my $block_command (keys(%block_commands)) {
   $begin_line_commands{$block_command} = 1;
   $default_no_paragraph_commands{$block_command} = 1;
-  $default_no_paragraph_commands{'end '.$block_command} = 1;
 }
 
 my %close_paragraph_commands;
@@ -484,11 +477,6 @@
         } else {
           $parser->{$key} = $conf->{$key};
         }
-        if ($key eq 'test' and $conf->{$key}) {
-          $parser->{'force'} = 1;
-          $parser->{'error_limit'} = 1000;
-          $parser->{'error'} = 'return';
-        }
       } else {
         warn "$key not a possible configuration in Texinfo::Parser::parser\n";
       }
@@ -501,6 +489,7 @@
     $parser->{'no_paragraph_commands'}->{$name.'index'} = 1;
   }
   $parser->{'errors_warnings'} = [];
+  $parser->{'errors_nrs'} = 0;
   return $parser;
 }
 
@@ -533,16 +522,10 @@
 
 sub tree_to_texi ($);
 
-sub tree ($)
-{
-  my $self = shift;
-  return $self->{'tree'};
-}
-
 sub errors ($)
 {
   my $self = shift;
-  return $self->{'errors_warnings'};
+  return ($self->{'errors_warnings'}, $self->{'error_nrs'});
 }
 
 
@@ -576,7 +559,6 @@
 sub _line_warn($$$)
 {
   my $parser = shift;
-  return if ($parser->{'no_warn'});
   my $text = shift;
   chomp ($text);
   my $line_number = shift;
@@ -593,28 +575,14 @@
     $warn_line = sprintf($parser->__("%s:%d: warning: %s\n"),
                          $file, $line_number->{'line_nr'}, $text);
   }
-  if ($parser->{'generate'}) {
-    warn $warn_line;
-  } else {
     warn $warn_line if ($parser->{'debug'});
     push @{$parser->{'errors_warnings'}},
          { 'type' => 'warning', 'text' => $text, 'error_line' => $warn_line,
            %{$line_number} };
-  }
 }
 
-my $error_nrs = 0;
-sub _check_errors($)
-{
-  my $parser = shift;
-  $error_nrs ++;
-  if ($error_nrs >= $parser->{'error_limit'}) {
-    warn $parser->__("Too many errors!  Gave up.\n")
-      if ($parser->{'error'} eq 'generate');
-    return 1;
-  }
-  return 0;
-}
+#  if ($error_nrs >= $parser->{'error_limit'}) {
+#    warn $parser->__("Too many errors!  Gave up.\n")
 
 sub _line_error($$$)
 {
@@ -629,17 +597,12 @@
     $macro_text = " (possibly involving address@hidden>{'macro'})" 
        if ($line_number->{'macro'} ne '');
     my $error_text = "$file:$line_number->{'line_nr'}: $text$macro_text\n";
-    if ($parser->{'error'} eq 'generate') {
-      warn "$error_text";
-    } else {
       warn "$error_text" if ($parser->{'debug'});
       push @{$parser->{'errors_warnings'}},
            { 'type' => 'error', 'text' => $text, 'error_line' => $error_text,
              %{$line_number} };
     }
-    return 1 unless ($parser->{'force'});
-  }
-  return (_check_errors($parser));
+  $parser->{'error_nrs'}++;
 }
 
 sub _parse_macro_command($$)
@@ -684,14 +647,13 @@
 
   my $located_line_nr = $line_nr;
   # use the beginning of the @-command for the error message
-  # line number if available.
+  # line number if available. FIXME. not implemented
   $located_line_nr = $current->{'parent'}->{'line_nr'}
     if ($current->{'parent'}->{'line_nr'});
-  my $error = _line_error ($self,
-                           sprintf($self->__("%c%s missing close brace"),
+  _line_error ($self, sprintf($self->__("%c%s missing close brace"),
                ord('@'), $current->{'parent'}->{'cmdname'}), $located_line_nr);
   $current = $current->{'parent'}->{'parent'};
-  return ($current, $error);
+  return $current;
 }
 
 sub _end_paragraph ($$$)
@@ -703,15 +665,13 @@
   while ($current->{'parent'} and $current->{'parent'}->{'cmdname'}
           and exists $brace_commands{$current->{'parent'}->{'cmdname'}}
           and !exists 
$context_brace_commands{$current->{'parent'}->{'cmdname'}}) {
-    my $error;
-    ($current, $error) = _close_brace_command($self, $current, $line_nr);
-    return ($current, $error) if ($error);
+    $current = _close_brace_command($self, $current, $line_nr);
   }
   if ($current->{'type'} and $current->{'type'} eq 'paragraph') {
     print STDERR "CLOSE PARA\n" if ($self->{'debug'});
     $current = $current->{'parent'};
   }
-  return ($current, 0);
+  return $current;
 }
 
 # a command arg means closing until that command is found
@@ -724,9 +684,7 @@
   my $line_nr = shift;
   my $command = shift;
 
-  my $error;
-  ($current, $error) = _end_paragraph($self, $current, $line_nr);
-  return ($current, $error) if ($error);
+  $current = _end_paragraph($self, $current, $line_nr);
 
         # stop if the command is found
   while (!($command and $current->{'cmdname'}
@@ -745,8 +703,7 @@
                        and 
$context_brace_commands{$current->{'parent'}->{'cmdname'}})))){
     if ($current->{'cmdname'}
         and exists($block_commands{$current->{'cmdname'}})) {
-      my $error = $self->_line_error(
-                           sprintf($self->__("No matching `%cend %s'"),
+      $self->_line_error(sprintf($self->__("No matching `%cend %s'"),
                                    ord('@'), $current->{'cmdname'}), $line_nr);
       pop @{$self->{'context'}} if 
          ($preformatted_commands{$current->{'cmdname'}}
@@ -754,15 +711,13 @@
       $current = $current->{'parent'};
     } elsif ($current->{'parent'}->{'cmdname'}
              and exists 
$context_brace_commands{$current->{'parent'}->{'cmdname'}}) {
-      ($current, $error) = _close_brace_command($self, $current, $line_nr);
+      $current = _close_brace_command($self, $current, $line_nr);
       pop @{$self->{'context'}};
     } else { # silently close containers and @-commands without @end
       $current = $current->{'parent'};
     }
 
-    return ($current, $error) if ($error);
-    ($current, $error) = _end_paragraph($self, $current, $line_nr);
-    return ($current, $error) if ($error);
+    $current = _end_paragraph($self, $current, $line_nr);
   }
 
   if ($command and $current->{'cmdname'} 
@@ -772,7 +727,7 @@
          or $menu_commands{$current->{'cmdname'}});
     $current = $current->{'parent'}
   }
-  return ($current, 0);
+  return $current;
 }
 
 # begin paragraph if needed.  If not try to merge with the previous
@@ -929,9 +884,7 @@
         # not in math or preformatted
         and !$no_paragraph_contexts{$self->{'context'}->[-1]}) {
       print STDERR "EMPTY LINE\n" if ($self->{'debug'});
-      my $error;
-      ($current, $error) = _end_paragraph($self, $current, $line_nr);
-      return undef if ($error);
+      $current = _end_paragraph($self, $current, $line_nr);
       push @{$current->{'contents'}}, { 'type' => 'normal_line', 
                                         'text' => $line,
                                         'parent' => $current };
@@ -1027,10 +980,8 @@
       if ($line =~ s/address@hidden([a-zA-Z][\w-]*)//) {
         my $end_command = $1;
         print STDERR "END $end_command\n" if ($self->{'debug'});
-        my $error;
-        ($current, $error) = _end_block_command($self, $current, $line_nr,
+        $current = _end_block_command($self, $current, $line_nr,
                                                 $end_command);
-        return undef if ($error);
         last unless ($line =~ /\S/);
       } elsif ($line =~ s/^\@(["'address@hidden,\.!\?\s\*\-\^`=:\|\/\\])//o 
                or $line =~ s/^\@([a-zA-Z][\w-]*)//o) {
@@ -1057,22 +1008,17 @@
         }
 
         if ($close_paragraph_commands{$command}) {
-          my $error;
-          ($current, $error) = _end_paragraph($self, $current, $line_nr);
-          return undef if ($error);
+          $current = _end_paragraph($self, $current, $line_nr);
         }
 
         if (defined($self->{'misc_commands'}->{$command})) {
           if ($root_commands{$command}) {
-            my $error;
-            ($current, $error) = _end_block_command($self, $current, $line_nr);
-            return undef if ($error);
+            $current = _end_block_command($self, $current, $line_nr);
           }
             
-          my ($args, $line_arg, $error);
-          ($line, $args, $line_arg, $error) 
+          my ($args, $line_arg);
+          ($line, $args, $line_arg) 
              = $self->_parse_misc_command($line, $command, $line_nr);
-          return undef if ($error);
 
           if ($command eq 'item' or $command eq 'itemx' 
                or $command eq 'headitem' or $command eq 'tab') {
@@ -1086,7 +1032,7 @@
                     'contents' => [] };
                 $current = $parent->{'contents'}->[-1];
               } else {
-                return undef if $self->_line_error 
(sprintf($self->__("address@hidden not meaningful inside address@hidden' 
block"), $command, $parent->{'cmdname'}), $line_nr);
+                $self->_line_error (sprintf($self->__("address@hidden not 
meaningful inside address@hidden' block"), $command, $parent->{'cmdname'}), 
$line_nr);
               }
             # *table
             } elsif ($parent = _item_line_parent($current)) {
@@ -1097,7 +1043,7 @@
                   { 'cmdname' => $command, 'parent' => $current };
                 $line_arg = $line;
               } else {
-                return undef if $self->_line_error 
(sprintf($self->__("address@hidden not meaningful inside address@hidden' 
block"), $command, $parent->{'cmdname'}), $line_nr);
+                $self->_line_error (sprintf($self->__("address@hidden not 
meaningful inside address@hidden' block"), $command, $parent->{'cmdname'}), 
$line_nr);
               }
             # multitable
             } elsif ($parent = _item_multitable_parent($current)) {
@@ -1111,7 +1057,7 @@
                   if ($row->{'type'} eq 'before_item') {
                     $self->_line_warn($self->__("address@hidden before 
address@hidden"), $line_nr);
                   } elsif ($row->{'special'}->{'cell_number'} > 
$parent->{'special'}->{'max_columns'}) {
-                    return undef if $self->_line_error (sprintf($self->__("Too 
many columns in multitable item (max %d)"), 
$parent->{'special'}->{'max_columns'}), $line_nr);
+                    $self->_line_error (sprintf($self->__("Too many columns in 
multitable item (max %d)"), $parent->{'special'}->{'max_columns'}), $line_nr);
                   } else {
                     $row->{'special'}->{'cell_number'}++;
                     push @{$row->{'contents'}}, { 'cmdname' => $command,
@@ -1130,12 +1076,12 @@
                   $current = $row->{'contents'}->[-1];
                 }
               } else {
-                return undef if $self->_line_error 
(sprintf($self->__("address@hidden not meaningful inside address@hidden' 
block"), $command, $parent->{'cmdname'}), $line_nr);
+                $self->_line_error (sprintf($self->__("address@hidden not 
meaningful inside address@hidden' block"), $command, $parent->{'cmdname'}), 
$line_nr);
               }
             } elsif ($command eq 'tab') {
-              return undef if $self->_line_error($self->__("ignoring 
address@hidden outside of multitable"), $line_nr);
+              $self->_line_error($self->__("ignoring address@hidden outside of 
multitable"), $line_nr);
             } else {
-              return undef if $self->_line_error 
(sprintf($self->__("address@hidden outside of table or list"), $command), 
$line_nr);
+              $self->_line_error (sprintf($self->__("address@hidden outside of 
table or list"), $command), $line_nr);
             }
           } else {
             push @{$current->{'contents'}}, 
@@ -1146,7 +1092,7 @@
               $base_command =~ s/x$//;
               if (!$current->{'cmdname'} 
                    or $current->{'cmdname'} ne $base_command) {
-                return undef if $self->_line_error(sprintf($self->__("Must be 
in address@hidden' environment to use address@hidden'"), $base_command, 
$command), $line_nr);
+                $self->_line_error(sprintf($self->__("Must be in 
address@hidden' environment to use address@hidden'"), $base_command, $command), 
$line_nr);
               }
               push @{$self->{'context'}}, 'def';
               $current->{'contents'}->[-1]->{'type'} = "line_$base_command";
@@ -1180,9 +1126,7 @@
             $current = $current->{'contents'}->[-1];
             last;
           } else {
-            my $error;
-            ($current, $error) = _end_paragraph($self, $current, $line_nr);
-            return undef if ($error);
+            $current = _end_paragraph($self, $current, $line_nr);
             $line =~ s/\s*//;
             # the def command holds a line_def* which corresponds with the
             # definition line.  This allows to have a treatement similar
@@ -1241,9 +1185,8 @@
           if ($command eq 'verb') {
             if ($line =~ /^$/) {
               $current->{'type'} = '';
-              return undef
-                if (_line_error ($self, sprintf($self->
-                __("address@hidden without associated character"), $command), 
$line_nr));
+              _line_error ($self, sprintf($self->
+                __("address@hidden without associated character"), $command), 
$line_nr);
             } else {
               $line =~ s/^(.)//;
               $current->{'type'} = $1;
@@ -1272,8 +1215,7 @@
           }
 
           if ($line =~ /^\@/) {
-            return undef
-              if _line_error ($self, sprintf($self->
+            _line_error ($self, sprintf($self->
                      __("Use braces to give a command as an argument to 
address@hidden"),
                      $command), $line_nr);
           }
@@ -1308,7 +1250,6 @@
                               'parent' => $current,
                               'type' => 'command_as_argument'};
           } else {
-            return undef if 
               _line_error ($self,
                  sprintf($self->__("address@hidden expected braces"), 
$command), $line_nr);
           }
@@ -1320,8 +1261,7 @@
         my $separator = $1;
         print STDERR "SEPARATOR: $separator\n" if ($self->{'debug'});
         if ($separator eq '@') {
-          return undef if _line_error ($self,
-                                       $self->__("Unexpected \@"), $line_nr);
+          _line_error ($self, $self->__("Unexpected \@"), $line_nr);
         } elsif ($separator eq '{') {
           if ($current->{'parent'} 
               and (($current->{'parent'}->{'cmdname'}
@@ -1334,8 +1274,7 @@
             $current = $current->{'contents'}->[-1];
             print STDERR "BRACKETED\n" if ($self->{'debug'});
           } else {
-            return undef
-              if _line_error ($self, sprintf($self->__("Misplaced %c"),
+            _line_error ($self, sprintf($self->__("Misplaced %c"),
                                              ord('{')), $line_nr);
           }
 
@@ -1355,9 +1294,7 @@
              $current = $current->{'parent'}->{'parent'};
           # footnote caption closing
           } elsif ($context_brace_commands{$self->{'context'}->[-1]}) {
-             my $error;
-             ($current, $error) = _end_paragraph($self, $current, $line_nr);
-             return undef if ($error);
+             $current = _end_paragraph($self, $current, $line_nr);
              if ($current->{'parent'}
                    and $current->{'parent'}->{'cmdname'}
                    and $brace_commands{$current->{'parent'}->{'cmdname'}}
@@ -1368,8 +1305,7 @@
                $current = $current->{'parent'}->{'parent'};
             }
           } else {
-            return undef
-              if _line_error ($self, sprintf($self->__("Misplaced %c"),
+            _line_error ($self, sprintf($self->__("Misplaced %c"),
                                      ord('}')), $line_nr);
           }
         } elsif ($separator eq ','
@@ -1523,13 +1459,11 @@
             my @fractions;
             my $other_contents;
             if (address@hidden>{'contents'}}) {
-              return undef
-                if _line_error ($self, sprintf($self->__("Empty 
address@hidden"),
+              _line_error ($self, sprintf($self->__("Empty address@hidden"),
                                 $current->{'cmdname'}), $line_nr);
 
             } elsif (!defined($current->{'contents'}->[0]->{'text'})) {
-              return undef 
-                if _line_error ($self, sprintf($self->
+              _line_error ($self, sprintf($self->
                                  __("address@hidden accepts only fractions as 
argument"),
                                  $current->{'cmdname'}), $line_nr);
               $other_contents = $current->{'contents'};
@@ -1555,8 +1489,7 @@
                 if ($fraction =~ /^(\d*\.\d+)|(\d+)\.?$/) {
                   push @fractions, $fraction;
                 } else {
-                  return undef
-                    if _line_error ($self, sprintf($self->
+                  _line_error ($self, sprintf($self->
                                         __("column fraction not a number: %s"),
                                         $fraction), $line_nr);
                 }
@@ -1641,9 +1574,7 @@
       }
     }
   }
-  my $error;
-  ($current, $error) = _end_block_command($self, $current, $line_nr);
-  return undef if ($error);
+  $current = _end_block_command($self, $current, $line_nr);
   return $root;
 }
 
@@ -1785,9 +1716,8 @@
       $self->{'aliases'}->{$2} = $4;
       $args = [$2, $4];
     } else {
-      my $error = _line_error ($self, sprintf($self->
+      _line_error ($self, sprintf($self->
                               __("Bad argument to address@hidden"), $command), 
$line_nr);
-      return ('', '', '', $error);
     }
 
   } elsif ($command eq 'definfoenclose') {
@@ -1795,18 +1725,16 @@
       $args = [$1, $2, $3 ];
       $self->{'info_enclose'}->{$1} = [ $2, $3 ];
     } else {
-      my $error = _line_error ($self, sprintf($self->
+      _line_error ($self, sprintf($self->
                               __("Bad argument to address@hidden"), $command), 
$line_nr);
-      return ('', '', '', $error);
     } # FIXME warn about garbage remaining on the line?
 
   } elsif ($command eq 'set') {
     if ($line =~ /^(\s+)([\w\-]+)(\s+)(.*)$/) {
       $args = [$2, $4];
     } else {
-      my $error = _line_error ($self, sprintf($self->
+      _line_error ($self, sprintf($self->
                     __("%c%s requires a name"), ord('@'), $command), $line_nr);
-      return ('', '', '', $error);
     }
     $line = '';
 
@@ -1814,16 +1742,14 @@
     if ($line =~ s/^\s+(\w+)\s*//) {
       my $name = $1;
       if ($forbidden_index_name{$name}) {
-        my $error = _line_error($self, sprintf($self->
+        _line_error($self, sprintf($self->
                                 __("Reserved index name %s"),$name), $line_nr);
-        return ('', '', '', $error);
       } else {
         $self->{'misc_commands'}->{$name.'index'} = { 'arg' => 'line' };
       }
     } else {
-      my $error = _line_error ($self, sprintf($self->
+      _line_error ($self, sprintf($self->
                    __("Bad argument to address@hidden: %s"), $command, $line), 
$line_nr);
-      return ('', '', '', $error);
     }
 
   } elsif ($arg_spec eq 'line' or $arg_spec eq 'lineraw') {

Index: t/test_utils.pl
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/test_utils.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- t/test_utils.pl     26 Sep 2010 18:10:34 -0000      1.11
+++ t/test_utils.pl     27 Sep 2010 20:18:58 -0000      1.12
@@ -49,6 +49,7 @@
   my $parser = Texinfo::Parser->parser({'test' => 1, 'debug' => 
$self->{'debug'}});
   print STDERR "  TEST $test_name\n" if ($self->{'debug'});
   my $result =  $parser->parse_texi_text($test_text, 1);
+  my ($errors, $error_nrs) = $parser->errors();
 
   my $file = "t/results/$self->{'name'}/$test_name.pl";
   my $new_file = $file.'.new';
@@ -67,7 +68,7 @@
     #print STDERR "Generate: ".Data::Dumper->Dump([$result], ['$res']);
     my $out_result = "".Data::Dumper->Dump([$result], 
['$result_trees{\''.$test_name.'\'}']);
     $out_result .= "\n".'$result_texts{\''.$test_name.'\'} = 
\''.tree_to_texi($result)."';\n\n";
-    $out_result .= "".Data::Dumper->Dump([$parser->errors()], 
['$result_errors{\''.$test_name.'\'}']) ."\n\n";
+    $out_result .= "".Data::Dumper->Dump([$errors], 
['$result_errors{\''.$test_name.'\'}']) ."\n\n";
     print OUT $out_result;
     close (OUT);
     
@@ -93,7 +94,7 @@
     ok (Data::Compare::Compare($result, $result_trees{$test_name}, { 
'ignore_hash_keys' => [qw(parent)] }), $test_name.' tree' );
     #ok(Struct::Compare::compare($result, $result_trees{$test_name}), 
$test_name.' tree' );
     #ok (Data::Compare::Compare($result, $result_trees{$test_name}), 
$test_name.' tree' );
-    ok (Data::Compare::Compare($parser->errors(), $result_errors{$test_name}), 
$test_name.' errors' );
+    ok (Data::Compare::Compare($errors, $result_errors{$test_name}), 
$test_name.' errors' );
     is (tree_to_texi($result), $result_texts{$test_name}, $test_name.' text' );
   }
   #exit;