Author: mdiep
Date: Wed Dec 28 23:03:07 2005
New Revision: 10762
Modified:
trunk/languages/tcl/lib/expression.pir
trunk/languages/tcl/lib/parser.pir
trunk/languages/tcl/lib/tclbinaryops.pir
trunk/languages/tcl/t/cmd_expr.t
Log:
tcl: Fix [expr {"foo"eq{foo}}] and related ops/parsing and add tests
Modified: trunk/languages/tcl/lib/expression.pir
==============================================================================
--- trunk/languages/tcl/lib/expression.pir (original)
+++ trunk/languages/tcl/lib/expression.pir Wed Dec 28 23:03:07 2005
@@ -256,16 +256,14 @@ number:
.return get_number(expr, pos)
quote:
- $P0 = new .Hash
- $P0[93] = 1 # ]
- $P0[59] = 1 # ;
- .return get_quote(expr, $P0, pos)
+ ($P0, $I0) = get_quote(expr, pos)
+ inc $I0
+ .return($P0, $I0)
brace:
- $P0 = new .Hash
- $P0[93] = 1 # ]
- $P0[59] = 1 # ;
- .return get_brace(expr, $P0, pos)
+ ($P0, $I0) = get_brace(expr, pos)
+ inc $I0
+ .return($P0, $I0)
unary:
.return get_unary(expr, pos)
Modified: trunk/languages/tcl/lib/parser.pir
==============================================================================
--- trunk/languages/tcl/lib/parser.pir (original)
+++ trunk/languages/tcl/lib/parser.pir Wed Dec 28 23:03:07 2005
@@ -304,14 +304,14 @@ done:
dispatch_sub:
$S0 = dispatch[char]
$P0 = find_name $S0
- (word, pos) = $P0(tcl_code, chars, pos)
+ (word, pos) = $P0(tcl_code, pos, chars)
inc pos
really_done:
.return(word, pos)
.end
-=item C<(pmc word, int pos) = get_quote(string tcl_code, pmc chars, int pos)>
+=item C<(pmc word, int pos) = get_quote(string tcl_code, int pos, pmc chars)>
Parses a quote and returns a TclWord object containing the separate
parts (or, if there's only one, it's child).
@@ -325,8 +325,9 @@ parts (or, if there's only one, it's chi
.sub get_quote
.param string tcl_code
- .param pmc chars
.param int pos
+ .param pmc chars :optional
+ .param int has_chars :opt_flag
.local int start
start = pos + 1
@@ -388,6 +389,7 @@ missing_quote:
check_chars:
$I0 = pos + 1
if $I0 == len goto save_end
+ unless has_chars goto save_end
$I1 = is_cclass .CCLASS_WHITESPACE, tcl_code, $I0
if $I1 == 1 goto save_end
$I1 = ord tcl_code, $I0
@@ -414,7 +416,7 @@ really_done:
.return(word, pos)
.end
-=item C<(pmc const, int pos) = get_brace(string tcl_code, pmc chars, int pos)>
+=item C<(pmc const, int pos) = get_brace(string tcl_code, int pos, pmc chars)>
Parses a {} quoted expression, returning a TclConst object.
@@ -427,8 +429,9 @@ Parses a {} quoted expression, returning
.sub get_brace
.param string tcl_code
- .param pmc chars
.param int pos
+ .param pmc chars :optional
+ .param int has_chars :opt_flag
.local int start, len
start = pos + 1
@@ -462,6 +465,7 @@ missing_close_brace:
check_chars:
$I0 = pos + 1
if $I0 == len goto done
+ unless has_chars goto done
$I1 = is_cclass .CCLASS_WHITESPACE, tcl_code, $I0
if $I1 == 1 goto done
$I1 = ord tcl_code, $I0
Modified: trunk/languages/tcl/lib/tclbinaryops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclbinaryops.pir (original)
+++ trunk/languages/tcl/lib/tclbinaryops.pir Wed Dec 28 23:03:07 2005
@@ -76,9 +76,10 @@
$P1[1] = l_reg
$P1[2] = r_reg # $S%i=$P%i
$P1[3] = r_reg
- $P1[5] = register_num # $I%i = isne $S%i, $S%i
- $P1[6] = l_reg
- $P1[7] = r_reg
+ $P1[4] = register_num # $I%i = isne $S%i, $S%i
+ $P1[5] = l_reg
+ $P1[6] = r_reg
+ $P1[7] = register_num # $P%i = new .String
$P1[8] = register_num # $P%i = $I%i
$P1[9] = register_num
Modified: trunk/languages/tcl/t/cmd_expr.t
==============================================================================
--- trunk/languages/tcl/t/cmd_expr.t (original)
+++ trunk/languages/tcl/t/cmd_expr.t Wed Dec 28 23:03:07 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 52;
+use Parrot::Test tests => 57;
use Test::More;
language_output_is("tcl",<<TCL,<<OUT,"int");
@@ -128,7 +128,7 @@ TCL
OUT
language_output_is("tcl",<<TCL,<<OUT,"==, eq");
- puts [expr 1 == 1]
+ puts [expr 2 == 2]
TCL
1
OUT
@@ -337,3 +337,33 @@ TCL
OUT
+language_output_is("tcl",<<'TCL',<<'OUT',"eq, extra characters after quotes");
+ puts [expr {"foo"eq{foo}}]
+TCL
+1
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"eq, extra characters after brace");
+ puts [expr {{foo}eq"foo"}]
+TCL
+1
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"eq (false)");
+ puts [expr {"foo"eq{baz}}]
+TCL
+0
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"ne (true)");
+ puts [expr {{foo}ne{baz}}]
+TCL
+1
+OUT
+
+language_output_is("tcl",<<'TCL',<<'OUT',"ne (false)");
+ puts [expr {{foo}ne{foo}}]
+TCL
+0
+OUT
+
