Author: coke
Date: Wed Aug 3 20:11:02 2005
New Revision: 8797
Modified:
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/t/tcl_misc.t
Log:
Add tcl comment parsing back in, add a test to verify it.
Side effect, pass two more [set] tests from the tcl suite.
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Wed Aug 3 20:11:02 2005
@@ -46,17 +46,49 @@ get_commands:
chars[59] = 1 # ;
next_command:
+ # Do we have a comment? If so, skip to the next position where
+ # We might have a command.
+ pos = skip_comment(tcl_code, pos)
+
.local pmc command
(command, pos) = get_command(tcl_code, chars, pos)
isnull command, done
push commands, command
goto next_command
-
+
done:
.return(commands)
.end
+.sub skip_comment
+ .param string tcl_code
+ .param int pos
+
+ .local pmc chars
+ chars = new Hash
+ chars[10] = 1 # \n
+ .local int peek_pos
+get:
+ .local pmc command
+ null command
+
+ # try to get a command name
+ .local pmc word
+ (word, peek_pos) = get_word(tcl_code, chars, pos)
+ isnull word, check
+ $S0 = word
+ $I0 = ord $S0, 0
+ if $I0 == 35 goto got_comment
+check:
+ .return(pos)
+got_comment:
+ .local int new_pos
+ new_pos = index tcl_code, "\n", pos
+ inc new_pos
+ .return (new_pos)
+.end
+
.sub get_command
.param string tcl_code
.param pmc chars
@@ -65,7 +97,7 @@ done:
get:
.local pmc command
null command
-
+
# try to get a command name
.local pmc word
(word, pos) = get_word(tcl_code, chars, pos)
Modified: trunk/languages/tcl/t/tcl_misc.t
==============================================================================
--- trunk/languages/tcl/t/tcl_misc.t (original)
+++ trunk/languages/tcl/t/tcl_misc.t Wed Aug 3 20:11:02 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 12;
+use Parrot::Test tests => 13;
use Test::More;
use vars qw($TODO);
@@ -81,8 +81,15 @@ TCL
invalid command name "a"
OUT
-language_output_is("tcl",<<'TCL',<<'OUT',"comments must *start* commands");
+language_output_is("tcl",<<'TCL',<<'OUT',"comments must *start* commands
(doesn't)");
puts 4 # comment
TCL
bad argument "comment": should be "nonewline"
OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"comments must *start* commands
(does)");
+# comment
+puts 1
+TCL
+1
+OUT
