Author: mdiep
Date: Thu Aug 11 19:55:15 2005
New Revision: 8924
Modified:
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/t/cmd_list.t
trunk/languages/tcl/t/tcl_misc.t
Log:
Add two error messages:
- extra characters after close-brace
- extra characters after close-quote
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Thu Aug 11 19:55:15 2005
@@ -303,14 +303,14 @@ done:
dispatch_sub:
$S0 = dispatch[char]
$P0 = find_name $S0
- (word, pos) = $P0(tcl_code, pos)
+ (word, pos) = $P0(tcl_code, chars, pos)
inc pos
really_done:
.return(word, pos)
.end
-=item C<(pmc word, int pos) = get_quote(string tcl_code, int pos)>
+=item C<(pmc word, int pos) = get_quote(string tcl_code, pmc chars, int pos)>
Parses a quote and returns a TclWord object containing the separate
parts (or, if there's only one, it's child).
@@ -324,6 +324,7 @@ parts (or, if there's only one, it's chi
.sub get_quote
.param string tcl_code
+ .param pmc chars
.param int pos
.local int start
@@ -343,7 +344,7 @@ loop:
if $I0 == 92 goto backslash # \
if $I0 == 36 goto variable # $
if $I0 == 91 goto subcommand # [
- if $I0 == 34 goto done # "
+ if $I0 == 34 goto check_chars # "
goto loop
backslash:
inc pos
@@ -385,6 +386,19 @@ missing_quote:
$P0["_message"] = "missing quote"
throw $P0
+check_chars:
+ $I0 = pos + 1
+ if $I0 == len goto done
+ $I1 = is_whitespace tcl_code, $I0
+ if $I1 == 1 goto done
+ $I1 = ord tcl_code, $I0
+ $I1 = exists chars[$I1]
+ if $I1 == 1 goto done
+
+ $P0 = new Exception
+ $P0["_message"] = "extra characters after close-quote"
+ throw $P0
+
done:
$I0 = pos - start
$S0 = substr tcl_code, start, $I0
@@ -396,7 +410,7 @@ done:
.return(word, pos)
.end
-=item C<(pmc const, int pos) = get_brace(string tcl_code, int pos)>
+=item C<(pmc const, int pos) = get_brace(string tcl_code, pmc chars, int pos)>
Parses a {} quoted expression, returning a TclConst object.
@@ -409,6 +423,7 @@ Parses a {} quoted expression, returning
.sub get_brace
.param string tcl_code
+ .param pmc chars
.param int pos
.local int start, len
@@ -434,7 +449,7 @@ left:
goto loop
right:
dec depth
- if depth == 0 goto done
+ if depth == 0 goto check_chars
goto loop
missing_close_brace:
@@ -442,6 +457,19 @@ missing_close_brace:
$P0["_message"] = "missing close-brace"
throw $P0
+check_chars:
+ $I0 = pos + 1
+ if $I0 == len goto done
+ $I1 = is_whitespace tcl_code, $I0
+ if $I1 == 1 goto done
+ $I1 = ord tcl_code, $I0
+ $I1 = exists chars[$I1]
+ if $I1 == 1 goto done
+
+ $P0 = new Exception
+ $P0["_message"] = "extra characters after close-brace"
+ throw $P0
+
done:
$I0 = pos - start
Modified: trunk/languages/tcl/t/cmd_list.t
==============================================================================
--- trunk/languages/tcl/t/cmd_list.t (original)
+++ trunk/languages/tcl/t/cmd_list.t Thu Aug 11 19:55:15 2005
@@ -2,9 +2,8 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 16;
+use Parrot::Test tests => 15;
use Test::More;
-use vars qw($TODO);
language_output_is("tcl",<<'TCL',<<OUT,"no elements");
puts [list]
@@ -97,11 +96,3 @@ TCL
\]
OUT
-TODO: {
- local $TODO = "need smarter string to list processing.";
-language_output_is("tcl",<<'TCL',<<'OUT',"extra characters after close brace");
- list {a}a
-TCL
-extra characters after close brace
-OUT
-}
Modified: trunk/languages/tcl/t/tcl_misc.t
==============================================================================
--- trunk/languages/tcl/t/tcl_misc.t (original)
+++ trunk/languages/tcl/t/tcl_misc.t Thu Aug 11 19:55:15 2005
@@ -2,9 +2,8 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 18;
+use Parrot::Test tests => 19;
use Test::More;
-use vars qw($TODO);
language_output_is("tcl",<<'TCL',<<OUT,"leading spacex2 should be ok");
puts Parsing
@@ -124,15 +123,15 @@ TCL
2
OUT
-TODO: {
-local $TODO = "unimplemented";
+language_output_is("tcl",<<'TCL',<<'OUT',"extra characters after close-quote");
+ list "a"a
+TCL
+extra characters after close-quote
+OUT
-language_output_is("tcl",<<'TCL',<<'OUT',"no extra characters after close
quote")
-set a 2
-puts [set "a"a]
-puts 1
+language_output_is("tcl",<<'TCL',<<'OUT',"extra characters after close-brace");
+ list {a}a
TCL
-extra characters after close quote
+extra characters after close-brace
OUT
-}
