Author: mdiep
Date: Sun Aug 7 19:16:02 2005
New Revision: 8863
Modified:
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/t/tcl_misc.t
Log:
tcl: Commit a test for a comment bug and fix it.
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Sun Aug 7 19:16:02 2005
@@ -75,22 +75,27 @@ done:
.local pmc chars
chars = new Hash
chars[10] = 1 # \n
+
+ .local pmc word
+ .local int orig, len
+ orig = pos
+ len = length tcl_code
get:
# try to get a command name
- .local pmc word
- .local int peek_pos
- (word, peek_pos) = get_word(tcl_code, chars, pos)
- isnull word, check
+ if pos >= len goto check
+ (word, pos) = get_word(tcl_code, chars, pos)
+ inc pos
+ isnull word, get
$S0 = word
$I0 = ord $S0, 0
if $I0 == 35 goto got_comment
check:
- .return(pos)
+ .return(orig)
got_comment:
+ dec pos
.local int new_pos
new_pos = index tcl_code, "\n", pos
- inc new_pos
.return (new_pos)
.end
Modified: trunk/languages/tcl/t/tcl_misc.t
==============================================================================
--- trunk/languages/tcl/t/tcl_misc.t (original)
+++ trunk/languages/tcl/t/tcl_misc.t Sun Aug 7 19:16:02 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 17;
+use Parrot::Test tests => 18;
use Test::More;
use vars qw($TODO);
@@ -93,6 +93,15 @@ TCL
1
OUT
+language_output_is("tcl",<<'TCL',<<'OUT',"comments with a blank line in
between");
+#one
+
+#two
+puts foo
+TCL
+foo
+OUT
+
language_output_is("tcl",<<'TCL',<<'OUT',"comments must *start* commands
(does), with whitespace");
# comment
puts 1
