[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
texinfo/tp Texinfo/Parser.pm t/06columnfraction...
|
From: |
Patrice Dumas |
|
Subject: |
texinfo/tp Texinfo/Parser.pm t/06columnfraction... |
|
Date: |
Tue, 21 Sep 2010 21:22:14 +0000 |
CVSROOT: /sources/texinfo
Module name: texinfo
Changes by: Patrice Dumas <pertusus> 10/09/21 21:22:14
Modified files:
tp/Texinfo : Parser.pm
tp/t : 06columnfractions.t test_utils.pl
tp/t/results : columnfractions.pl
Log message:
Handle menu entry parsing separators.
Don't return the error messages, but store them.
Check error messages for tests.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Parser.pm?cvsroot=texinfo&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/06columnfractions.t?cvsroot=texinfo&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/test_utils.pl?cvsroot=texinfo&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/results/columnfractions.pl?cvsroot=texinfo&r1=1.1&r2=1.2
Patches:
Index: Texinfo/Parser.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Parser.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- Texinfo/Parser.pm 20 Sep 2010 19:57:44 -0000 1.3
+++ Texinfo/Parser.pm 21 Sep 2010 21:22:14 -0000 1.4
@@ -42,6 +42,8 @@
tree_to_texi
parse_texi_text
parse_texi_line
+ tree
+ errors
) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -64,7 +66,7 @@
}
my %default_configuration = (
- 'error' => 'generate', #
+ 'error' => 'generate', # the contrary could be 'return'
'force' => 0,
'no_warn' => 0,
'error_limit' => 100,
@@ -349,8 +351,7 @@
'majorheading',
'chapheading',
'centerchap'
-)
-{
+) {
$misc_commands{$sectioning_command} = { 'arg' => 'line' };
$root_commands{$sectioning_command} = 1 unless ($sectioning_command =~
/heading/)
}
@@ -405,12 +406,10 @@
else {
$parser->{$key} = $conf->{$key};
}
- $parser->{'no_warn'} = 1 if
- ($key eq 'error' and $conf->{$key} ne 'generate'
- and !exists($conf->{'no_warn'}));
if ($key eq 'test' and $conf->{$key}) {
$parser->{'force'} = 1;
$parser->{'error_limit'} = 1000;
+ $parser->{'error'} = 'return';
}
}
else {
@@ -422,6 +421,7 @@
foreach my $name (@{$parser->{'indices'}}, @default_index_names) {
$parser->{'misc_commands'}->{$name.'index'} = { 'arg' => 'line' };
}
+ $parser->{'errors_warnings'} = [];
return $parser;
}
@@ -451,6 +451,19 @@
sub tree_to_texi ($);
+sub tree ($)
+{
+ my $self = shift;
+ return $self->{'tree'};
+}
+
+sub errors ($)
+{
+ my $self = shift;
+ return $self->{'errors_warnings'};
+}
+
+
# internal sub
sub _line_warn($$$)
@@ -464,11 +477,20 @@
my $file = $line_number->{'file_name'};
# otherwise out of source build fail since the file names are different
$file =~ s/^.*\/// if ($parser->{'test'});
+ my $warn_line;
if ($line_number->{'macro'} ne '') {
- warn sprintf($parser->__("%s:%d: warning: %s (possibly involving
address@hidden)\n"), $file, $line_number->{'line_nr'}, $text,
$line_number->{'macro'});
+ $warn_line = sprintf($parser->__("%s:%d: warning: %s (possibly involving
address@hidden)\n"), $file, $line_number->{'line_nr'}, $text,
$line_number->{'macro'});
}
else {
- warn sprintf($parser->__("%s:%d: warning: %s\n"), $file,
$line_number->{'line_nr'}, $text);
+ $warn_line = sprintf($parser->__("%s:%d: warning: %s\n"), $file,
$line_number->{'line_nr'}, $text);
+ }
+ if ($parser->{'generate'})
+ {
+ warn $warn_line;
+ }
+ else
+ {
+ push @{$parser->{'errors_warnings'}}, { 'type' => 'warning', 'text' =>
$text, 'error_line' => $warn_line, %{$line_number} };
}
}
@@ -499,11 +521,11 @@
my $error_text = "$file:$line_number->{'line_nr'}: $text$macro_text\n";
if ($parser->{'error'} eq 'generate') {
warn "$error_text";
- return 1 unless ($parser->{'force'});
}
else {
- return $error_text unless ($parser->{'force'});
+ push @{$parser->{'errors_warnings'}}, { 'type' => 'error', 'text' =>
$text, 'error_line' => $error_text, %{$line_number} };
}
+ return 1 unless ($parser->{'force'});
}
return (_check_errors($parser));
}
@@ -526,7 +548,8 @@
return $macro;
}
-sub _merge_text ($$) {
+sub _merge_text ($$)
+{
my $current = shift;
my $text = shift;
#if (@{$current->{'contents'}} and
exists($current->{'contents'}->[-1]->{'text'}) and
!$current->{'contents'}->[-1]->{'type'} and
$current->{'contents'}->[-1]->{'text'} !~ /\n/) {
@@ -574,6 +597,7 @@
my $maybe_menu_entry;
my $root = { 'contents' => [] };
+ $self->{'tree'} = $root;
my $current = $root;
# This holds the line number. Similar with line_nr, but simpler.
@@ -661,7 +685,7 @@
last;
}
}
- $line =~ s/^([^{}@,]*)//;
+ $line =~ s/^([^{}@,:\t.]*)//;
_merge_text ($current, $1) if ($1 ne '');
# separators: $maybe_menu_entry$command_comma$maybe_menu_name
@@ -697,7 +721,7 @@
my ($args, $line_arg, $error);
($line, $args, $line_arg, $error)
= $self->_parse_misc_command($line, $command, $line_nr);
- return $error if ($error);
+ return undef if ($error);
push @{$current->{'contents'}},
{ 'cmdname' => $command, 'parent' => $current };
@@ -763,8 +787,7 @@
$current = $current->{'contents'}->[-1];
if ($command eq 'verb') {
if ($line =~ /^$/) {
- my $error = _line_error ($self,
sprintf($self->__("address@hidden without associated character"), $command),
$line_nr);
- return $error if ($error);
+ return undef if (_line_error ($self,
sprintf($self->__("address@hidden without associated character"), $command),
$line_nr));
}
else {
$line =~ s/^(.)//;
@@ -789,8 +812,7 @@
_line_warn ($self, sprintf($self->__("Accent command
address@hidden' must not be followed by whitespace"), $command), $line_nr);
}
if ($line =~ /^\@/) {
- my $error = _line_error ($self, sprintf($self->__("Use braces to
give a command as an argument to address@hidden"), $command), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self, sprintf($self->__("Use braces
to give a command as an argument to address@hidden"), $command), $line_nr);
}
if ($line =~ s/^(\S)//o) {
my $accent = { 'cmdname' => $command, 'parent' => $current };
@@ -811,12 +833,11 @@
# unknown
}
}
- elsif ($line =~ s/^([{}@,])//) {
+ elsif ($line =~ s/^([{}@,:\t.])//) {
my $separator = $1;
print STDERR "SEPARATOR: $separator\n" if ($self->{'debug'});
if ($separator eq '@') {
- my $error = _line_error ($self, $self->__("Unexpected \@"),
$line_nr);
- return $error if ($error);
+ return undef if _line_error ($self, $self->__("Unexpected \@"),
$line_nr);
}
elsif ($separator eq '{') {
if ($current->{'cmdname'} and
@@ -825,8 +846,7 @@
$current = $current->{'args'}->[-1];
}
else {
- my $error = _line_error ($self, sprintf($self->__("Misplaced %c"),
ord('{')), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self, sprintf($self->__("Misplaced
%c"), ord('{')), $line_nr);
}
}
elsif ($separator eq '}') {
@@ -835,12 +855,10 @@
$current = $current->{'parent'};
}
else {
- my $error = _line_error ($self, sprintf($self->__("Misplaced %c"),
ord('}')), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self, sprintf($self->__("Misplaced
%c"), ord('}')), $line_nr);
}
}
- elsif ($separator eq ',') {
- if ($current->{'parent'}->{'remaining_args'}) {
+ elsif ($separator eq ',' and $current->{'parent'}->{'remaining_args'})
{
$line =~ s/^\s*//;
my $type = $current->{'type'};
$current = $current->{'parent'};
@@ -848,9 +866,16 @@
push @{$current->{'args'}}, { 'type' => $type, 'parent' =>
$current, 'contents' => [] };
$current = $current->{'args'}->[-1];
}
- else {
- _merge_text ($current, ',');
+ # menu node if there is a :
+ # . must be followed by a space to stop the node name.
+ # cf texi2htmll.pl l 13425
+ elsif ($separator =~ /[,\t.]/ and $current->{'type'} eq 'FIXME') {
}
+ # menu node
+ elsif ($separator eq ':' and $current->{'type'} eq 'FIXME') {
+ }
+ else {
+ _merge_text ($current, $separator);
}
}
else {
@@ -870,12 +895,10 @@
my @fractions;
my $other_contents;
if (address@hidden>{'contents'}}) {
- my $error = _line_error ($self, sprintf($self->__("Empty
address@hidden"), $current->{'cmdname'}), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self, sprintf($self->__("Empty
address@hidden"), $current->{'cmdname'}), $line_nr);
}
elsif (!defined($current->{'contents'}->[0]->{'text'})) {
- my $error = _line_error ($self,
sprintf($self->__("address@hidden accepts only fractions as argument"),
$current->{'cmdname'}), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self,
sprintf($self->__("address@hidden accepts only fractions as argument"),
$current->{'cmdname'}), $line_nr);
$other_contents = $current->{'contents'};
}
else {
@@ -895,8 +918,7 @@
push @fractions, $fraction;
}
else {
- my $error = _line_error ($self, sprintf($self->__("column
fraction not a number: %s"), $fraction), $line_nr);
- return $error if ($error);
+ return undef if _line_error ($self,
sprintf($self->__("column fraction not a number: %s"), $fraction), $line_nr);
}
}
}
Index: t/06columnfractions.t
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/06columnfractions.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- t/06columnfractions.t 20 Sep 2010 21:07:58 -0000 1.4
+++ t/06columnfractions.t 21 Sep 2010 21:22:14 -0000 1.5
@@ -6,7 +6,7 @@
require 't/test_utils.pl';
my $generate;
-# $generate = 1;
+ $generate = 1;
my @test_cases = (
[ 'good', '@multitable @columnfractions 0.4 .6 5.
Index: t/test_utils.pl
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/test_utils.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- t/test_utils.pl 20 Sep 2010 21:07:58 -0000 1.1
+++ t/test_utils.pl 21 Sep 2010 21:22:14 -0000 1.2
@@ -4,9 +4,10 @@
use Data::Dumper;
use Data::Compare;
-use vars qw(%result_texts %result_trees);
+use vars qw(%result_texts %result_trees %result_errors);
-sub new_test ($;$) {
+sub new_test ($;$)
+{
my $name = shift;
my $generate = shift;
my $file = "t/results/$name.pl";
@@ -17,8 +18,7 @@
open (*FH, ">$file") or die "Open $file: $!\n";
$test->{'fh'} = *FH;
my $FH = $test->{'fh'};
- print $FH 'use vars qw(%result_texts);'."\n\n";
- print $FH 'use vars qw(%result_trees);'."\n\n";
+ print $FH 'use vars qw(%result_texts %result_trees
%result_errors);'."\n\n";
}
else {
require "$file";
@@ -37,23 +37,29 @@
my $parser = Texinfo::Parser->parser({'test' => 1});
#my $parser = Texinfo::Parser->parser({'test' => 1, 'debug' => 1});
my $result = $parser->parse_texi_text($test_text, 1);
+ $result = $parser->tree () if (!$result);
if ($self->{'generate'}) {
local $Data::Dumper::Purity = 1;
$Data::Dumper::Sortkeys = 1;
my $FH = $self->{'fh'};
+ print $FH "################ $test_name\n";
print $FH "".Data::Dumper->Dump([$result],
['$result_trees{\''.$test_name.'\'}']);
print $FH "\n".'$result_texts{\''.$test_name.'\'} =
\''.tree_to_texi($result)."';\n\n";
+ print $FH "".Data::Dumper->Dump([$parser->errors()],
['$result_errors{\''.$test_name.'\'}']) ."\n\n";
+
print STDERR "--> $test_name\n".tree_to_texi($result)."\n";
}
else {
ok (Data::Compare::Compare($result, $result_trees{$test_name}, {
'ignore_hash_keys' => [qw(parent)] }), $test_name.' tree' );
+ ok (Data::Compare::Compare($parser->errors(), $result_errors{$test_name}),
$test_name.' errors' );
is (tree_to_texi($result), $result_texts{$test_name}, $test_name.' text' );
}
#exit;
}
-sub end_test($) {
+sub end_test($)
+{
my $self = shift;
if ($self->{'generate'}) {
my $FH = $self->{'fh'};
Index: t/results/columnfractions.pl
===================================================================
RCS file: /sources/texinfo/texinfo/tp/t/results/columnfractions.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- t/results/columnfractions.pl 20 Sep 2010 21:07:59 -0000 1.1
+++ t/results/columnfractions.pl 21 Sep 2010 21:22:14 -0000 1.2
@@ -1,7 +1,6 @@
-use vars qw(%result_texts);
-
-use vars qw(%result_trees);
+use vars qw(%result_texts %result_trees %result_errors);
+################ good
$result_trees{'good'} = {
'contents' => [
{
@@ -43,6 +42,10 @@
@end multitable
';
+$result_errors{'good'} = [];
+
+
+################ good_comment
$result_trees{'good_comment'} = {
'contents' => [
{
@@ -98,6 +101,10 @@
@end multitable
';
+$result_errors{'good_comment'} = [];
+
+
+################ good_space_comment
$result_trees{'good_space_comment'} = {
'contents' => [
{
@@ -147,6 +154,10 @@
@end multitable
';
+$result_errors{'good_space_comment'} = [];
+
+
+################ not_fraction
$result_trees{'not_fraction'} = {
'contents' => [
{
@@ -168,6 +179,20 @@
@end multitable
';
+$result_errors{'not_fraction'} = [
+ {
+ 'error_line' => ':1: column fraction not
a number: aaa
+',
+ 'file_name' => '',
+ 'line_nr' => 1,
+ 'macro' => '',
+ 'text' => 'column fraction not a number:
aaa',
+ 'type' => 'error'
+ }
+ ];
+
+
+################ empty
$result_trees{'empty'} = {
'contents' => [
{
@@ -189,6 +214,20 @@
@end multitable
';
+$result_errors{'empty'} = [
+ {
+ 'error_line' => ':1: Empty @columnfractions
+',
+ 'file_name' => '',
+ 'line_nr' => 1,
+ 'macro' => '',
+ 'text' => 'Empty @columnfractions',
+ 'type' => 'error'
+ }
+ ];
+
+
+################ empty_comment
$result_trees{'empty_comment'} = {
'contents' => [
{
@@ -224,6 +263,20 @@
@end multitable
';
+$result_errors{'empty_comment'} = [
+ {
+ 'error_line' => ':1: @columnfractions
accepts only fractions as argument
+',
+ 'file_name' => '',
+ 'line_nr' => 1,
+ 'macro' => '',
+ 'text' => '@columnfractions accepts only
fractions as argument',
+ 'type' => 'error'
+ }
+ ];
+
+
+################ wrong_command
$result_trees{'wrong_command'} = {
'contents' => [
{
@@ -276,5 +329,8 @@
@end multitable
';
+$result_errors{'wrong_command'} = [];
+
+
1;
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- texinfo/tp Texinfo/Parser.pm t/06columnfraction...,
Patrice Dumas <=