texinfo/tp Texinfo/Parser.pm t/50value.t t/resu...

[Patrice Dumas]

CVSROOT:        /sources/texinfo
Module name:    texinfo
Changes by:     Patrice Dumas <pertusus>        10/09/28 19:47:03

Modified files:
        tp/Texinfo     : Parser.pm 
Added files:
        tp/t           : 50value.t 
        tp/t/results/value: bad_syntax.pl simple.pl 

Log message:
        @value expansion.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/Texinfo/Parser.pm?cvsroot=texinfo&r1=1.25&r2=1.26
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/50value.t?cvsroot=texinfo&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/results/value/bad_syntax.pl?cvsroot=texinfo&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/texinfo/tp/t/results/value/simple.pl?cvsroot=texinfo&rev=1.1

Patches:
Index: Texinfo/Parser.pm
===================================================================
RCS file: /sources/texinfo/texinfo/tp/Texinfo/Parser.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -b -r1.25 -r1.26
--- Texinfo/Parser.pm   28 Sep 2010 19:05:00 -0000      1.25
+++ Texinfo/Parser.pm   28 Sep 2010 19:47:03 -0000      1.26
@@ -996,6 +996,25 @@
         $command = $self->{'aliases'}->{$command} 
            if (exists($self->{'aliases'}->{$command}));
         print STDERR "COMMAND $command\n" if ($self->{'debug'});
+
+        if ($command eq 'value') {
+          if ($line =~ s/^{([\w\-]+)}//) {
+            my $value = $1;
+            if (exists($self->{'values'}->{$value})) {
+              $line = $self->{'values'}->{$value} . $line;
+            } else {
+              # caller should expand something along 
+              # gdt('@{No value for `{value}\'@}', {'value' => $value}, 
{'keep_texi'=> 1});
+              push @{$current->{'contents'}}, { 'cmdname' => 'value',
+                                                'type' => $value };
+              _line_warn ($self, 
+                  sprintf($self->__("undefined flag: %s"), $value), $line_nr);
+            }
+          } else {
+            _line_error ($self, $self->__("Bad syntax for address@hidden"), 
$line_nr);
+          }
+        }
+
         if (defined($deprecated_commands{$command})) {
           if ($deprecated_commands{$command} eq '') {
             _line_warn($self, sprintf($self->__("%c%s is obsolete."), 
@@ -1023,8 +1042,8 @@
             $current = _end_block_command($self, $current, $line_nr);
           }
             
-          my ($args, $line_arg);
-          ($line, $args, $line_arg) 
+          my ($args, $line_arg, $special);
+          ($line, $args, $line_arg, $special) 
              = $self->_parse_misc_command($line, $command, $line_nr);
 
           if ($command eq 'item' or $command eq 'itemx' 
@@ -1093,7 +1112,8 @@
           } else {
             push @{$current->{'contents'}}, 
               { 'cmdname' => $command, 'parent' => $current };
-
+            $current->{'contents'}->[-1]->{'special'} = $special 
+                                              if (defined($special));
             if ($def_commands{$command}) {
               my $base_command = $command;
               $base_command =~ s/x$//;
@@ -1695,6 +1715,11 @@
     chomp($result);
     $result .= "\n" unless ($def_commands{$cmdname});
   }
+  $result .= '{'.$cmd->{'type'}.'}' if ($cmdname eq 'value');
+#  $result .= $cmd->{'special'}->{'arg'} if ($misc_commands{$cmdname} 
+#     and $cmd->{'special'} and $cmd->{'special'}->{'arg'});
+  $result .= "\n" if ($misc_commands{$cmdname} 
+      and $cmd->{'special'} and $cmd->{'special'}->{'arg'});
   #print STDERR "Result: $result\n";
   return $result;
 }
@@ -1710,6 +1735,7 @@
   my $line_arg;
   my $skip_spec = '';
   my $arg_spec = '';
+  my $special;
 
   $skip_spec = $self->{'misc_commands'}->{$command}->{'skip'}
     if (defined($self->{'misc_commands'}->{$command}->{'skip'}));
@@ -1742,6 +1768,7 @@
     } else {
       _line_error ($self, sprintf($self->
                     __("%c%s requires a name"), ord('@'), $command), $line_nr);
+      $special = { 'arg' => $line };
     }
     $line = '';
   } elsif ($command eq 'clear') {
@@ -1801,7 +1828,7 @@
   }
   # FIXME is the following useful?
   $line = '' if (!defined($line));
-  return ($line, $args, $line_arg, '');
+  return ($line, $args, $line_arg, $special);
 }
 
 1;

Index: t/50value.t
===================================================================
RCS file: t/50value.t
diff -N t/50value.t
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ t/50value.t 28 Sep 2010 19:47:03 -0000      1.1
@@ -0,0 +1,28 @@
+use strict;
+
+use Test::More;
+
+require 't/test_utils.pl';
+
+my @test_cases = (
+[ 'simple', '@set a-_5b the value @b{b} @c comment
+
address@hidden After value.
+'],
+['bad_syntax','
address@hidden
address@hidden 
address@hidden ?
address@hidden :-/ hey!
+
address@hidden
+
address@hidden
+']
+);
+
+our ($arg_test_case, $arg_generate, $arg_debug);
+
+run_all ('value', address@hidden, $arg_test_case,
+   $arg_generate, $arg_debug);
+

Index: t/results/value/bad_syntax.pl
===================================================================
RCS file: t/results/value/bad_syntax.pl
diff -N t/results/value/bad_syntax.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ t/results/value/bad_syntax.pl       28 Sep 2010 19:47:03 -0000      1.1
@@ -0,0 +1,163 @@
+use vars qw(%result_texts %result_trees %result_errors);
+
+$result_trees{'bad_syntax'} = {
+  'contents' => [
+    {
+      'parent' => {},
+      'text' => '
+',
+      'type' => 'normal_line'
+    },
+    {
+      'cmdname' => 'set',
+      'parent' => {},
+      'special' => {
+        'arg' => '
+'
+      }
+    },
+    {
+      'cmdname' => 'set',
+      'parent' => {},
+      'special' => {
+        'arg' => ' 
+'
+      }
+    },
+    {
+      'cmdname' => 'set',
+      'parent' => {},
+      'special' => {
+        'arg' => ' ?
+'
+      }
+    },
+    {
+      'cmdname' => 'set',
+      'parent' => {},
+      'special' => {
+        'arg' => ' :-/ hey!
+'
+      }
+    },
+    {
+      'parent' => {},
+      'text' => '
+',
+      'type' => 'normal_line'
+    },
+    {
+      'contents' => [
+        {
+          'parent' => {},
+          'text' => 'gurgl
+'
+        }
+      ],
+      'parent' => {},
+      'type' => 'paragraph'
+    },
+    {
+      'parent' => {},
+      'text' => '
+',
+      'type' => 'normal_line'
+    },
+    {
+      'cmdname' => 'value',
+      'type' => 'unknown'
+    },
+    {
+      'contents' => [
+        {
+          'parent' => {},
+          'text' => '
+'
+        }
+      ],
+      'parent' => {},
+      'type' => 'paragraph'
+    }
+  ]
+};
+$result_trees{'bad_syntax'}{'contents'}[0]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[1]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[2]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[3]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[4]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[5]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[6]{'contents'}[0]{'parent'} = 
$result_trees{'bad_syntax'}{'contents'}[6];
+$result_trees{'bad_syntax'}{'contents'}[6]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[7]{'parent'} = 
$result_trees{'bad_syntax'};
+$result_trees{'bad_syntax'}{'contents'}[9]{'contents'}[0]{'parent'} = 
$result_trees{'bad_syntax'}{'contents'}[9];
+$result_trees{'bad_syntax'}{'contents'}[9]{'parent'} = 
$result_trees{'bad_syntax'};
+
+$result_texts{'bad_syntax'} = '
address@hidden
address@hidden
address@hidden
address@hidden
+
+gurgl
+
address@hidden
+';
+
+$result_errors{'bad_syntax'} = [
+  {
+    'error_line' => ':2: @set requires a name
+',
+    'file_name' => '',
+    'line_nr' => 2,
+    'macro' => '',
+    'text' => '@set requires a name',
+    'type' => 'error'
+  },
+  {
+    'error_line' => ':3: @set requires a name
+',
+    'file_name' => '',
+    'line_nr' => 3,
+    'macro' => '',
+    'text' => '@set requires a name',
+    'type' => 'error'
+  },
+  {
+    'error_line' => ':4: @set requires a name
+',
+    'file_name' => '',
+    'line_nr' => 4,
+    'macro' => '',
+    'text' => '@set requires a name',
+    'type' => 'error'
+  },
+  {
+    'error_line' => ':5: @set requires a name
+',
+    'file_name' => '',
+    'line_nr' => 5,
+    'macro' => '',
+    'text' => '@set requires a name',
+    'type' => 'error'
+  },
+  {
+    'error_line' => ':7: Bad syntax for @value
+',
+    'file_name' => '',
+    'line_nr' => 7,
+    'macro' => '',
+    'text' => 'Bad syntax for @value',
+    'type' => 'error'
+  },
+  {
+    'error_line' => ':9: warning: undefined flag: unknown
+',
+    'file_name' => '',
+    'line_nr' => 9,
+    'macro' => '',
+    'text' => 'undefined flag: unknown',
+    'type' => 'warning'
+  }
+];
+
+

Index: t/results/value/simple.pl
===================================================================
RCS file: t/results/value/simple.pl
diff -N t/results/value/simple.pl
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ t/results/value/simple.pl   28 Sep 2010 19:47:03 -0000      1.1
@@ -0,0 +1,91 @@
+use vars qw(%result_texts %result_trees %result_errors);
+
+$result_trees{'simple'} = {
+  'contents' => [
+    {
+      'args' => [
+        {
+          'parent' => {},
+          'text' => 'a-_5b',
+          'type' => 'misc_arg'
+        },
+        {
+          'parent' => {},
+          'text' => 'the value @b{b} @c comment',
+          'type' => 'misc_arg'
+        }
+      ],
+      'cmdname' => 'set',
+      'parent' => {}
+    },
+    {
+      'parent' => {},
+      'text' => '
+',
+      'type' => 'normal_line'
+    },
+    {
+      'contents' => [
+        {
+          'parent' => {},
+          'text' => 'the value '
+        },
+        {
+          'args' => [
+            {
+              'contents' => [
+                {
+                  'parent' => {},
+                  'text' => 'b'
+                }
+              ],
+              'parent' => {},
+              'type' => 'brace_command_arg'
+            }
+          ],
+          'cmdname' => 'b',
+          'parent' => {},
+          'remaining_args' => 0
+        },
+        {
+          'parent' => {},
+          'text' => ' '
+        },
+        {
+          'args' => [
+            {
+              'parent' => {},
+              'text' => ' comment After value.
+',
+              'type' => 'misc_arg'
+            }
+          ],
+          'cmdname' => 'c',
+          'parent' => {}
+        }
+      ],
+      'parent' => {},
+      'type' => 'paragraph'
+    }
+  ]
+};
+$result_trees{'simple'}{'contents'}[0]{'args'}[0]{'parent'} = 
$result_trees{'simple'}{'contents'}[0];
+$result_trees{'simple'}{'contents'}[0]{'args'}[1]{'parent'} = 
$result_trees{'simple'}{'contents'}[0];
+$result_trees{'simple'}{'contents'}[0]{'parent'} = $result_trees{'simple'};
+$result_trees{'simple'}{'contents'}[1]{'parent'} = $result_trees{'simple'};
+$result_trees{'simple'}{'contents'}[2]{'contents'}[0]{'parent'} = 
$result_trees{'simple'}{'contents'}[2];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[1]{'args'}[0]{'contents'}[0]{'parent'}
 = $result_trees{'simple'}{'contents'}[2]{'contents'}[1]{'args'}[0];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[1]{'args'}[0]{'parent'} = 
$result_trees{'simple'}{'contents'}[2]{'contents'}[1];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[1]{'parent'} = 
$result_trees{'simple'}{'contents'}[2];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[2]{'parent'} = 
$result_trees{'simple'}{'contents'}[2];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[3]{'args'}[0]{'parent'} = 
$result_trees{'simple'}{'contents'}[2]{'contents'}[3];
+$result_trees{'simple'}{'contents'}[2]{'contents'}[3]{'parent'} = 
$result_trees{'simple'}{'contents'}[2];
+$result_trees{'simple'}{'contents'}[2]{'parent'} = $result_trees{'simple'};
+
+$result_texts{'simple'} = '@set a-_5b the value @b{b} @c comment
+the value @b{b} @c comment After value.
+';
+
+$result_errors{'simple'} = [];
+
+