Author: leo
Date: Fri Aug 19 00:17:05 2005
New Revision: 8997
Added:
branches/leo-ctx5/languages/tcl/lib/commands/after.pir
- copied unchanged from r8996, trunk/languages/tcl/lib/commands/after.pir
branches/leo-ctx5/languages/tcl/t/cmd_info.t (props changed)
- copied unchanged from r8996, trunk/languages/tcl/t/cmd_info.t
Modified:
branches/leo-ctx5/MANIFEST
branches/leo-ctx5/config/gen/makefiles/tcl.in
branches/leo-ctx5/languages/tcl/TODO
branches/leo-ctx5/languages/tcl/classes/tclfloat.pmc
branches/leo-ctx5/languages/tcl/classes/tclint.pmc
branches/leo-ctx5/languages/tcl/docs/howto.pod
branches/leo-ctx5/languages/tcl/docs/overview.pod
branches/leo-ctx5/languages/tcl/lib/commands/info.pir
branches/leo-ctx5/languages/tcl/lib/expression.pir
branches/leo-ctx5/languages/tcl/lib/tclconst.pir
branches/leo-ctx5/languages/tcl/t/cmd_break.t
branches/leo-ctx5/languages/tcl/t/cmd_continue.t
branches/leo-ctx5/languages/tcl/t/cmd_expr.t
branches/leo-ctx5/languages/tcl/tcl.pl
branches/leo-ctx5/t/op/number.t
Log:
merge -r8983:8996 from trunk
Modified: branches/leo-ctx5/MANIFEST
==============================================================================
--- branches/leo-ctx5/MANIFEST (original)
+++ branches/leo-ctx5/MANIFEST Fri Aug 19 00:17:05 2005
@@ -1373,6 +1373,7 @@ languages/tcl/examples/fact.tcl
languages/tcl/examples/hello.tcl [tcl]
languages/tcl/examples/koohii.tcl [tcl]
languages/tcl/examples/power.tcl [tcl]
+languages/tcl/lib/commands/after.pir [tcl]
languages/tcl/lib/commands/append.pir [tcl]
languages/tcl/lib/commands/array.pir [tcl]
languages/tcl/lib/commands/break.pir [tcl]
@@ -1448,6 +1449,7 @@ languages/tcl/t/cmd_format.t
languages/tcl/t/cmd_global.t [tcl]
languages/tcl/t/cmd_if.t [tcl]
languages/tcl/t/cmd_incr.t [tcl]
+languages/tcl/t/cmd_info.t [tcl]
languages/tcl/t/cmd_inline.t [tcl]
languages/tcl/t/cmd_join.t [tcl]
languages/tcl/t/cmd_lappend.t [tcl]
Modified: branches/leo-ctx5/config/gen/makefiles/tcl.in
==============================================================================
--- branches/leo-ctx5/config/gen/makefiles/tcl.in (original)
+++ branches/leo-ctx5/config/gen/makefiles/tcl.in Fri Aug 19 00:17:05 2005
@@ -17,6 +17,7 @@ PMCS = \
tclarray
DEPS = $(PARROT) \
+lib${slash}commands${slash}after.pir \
lib${slash}commands${slash}append.pir \
lib${slash}commands${slash}array.pir \
lib${slash}commands${slash}break.pir \
Modified: branches/leo-ctx5/languages/tcl/TODO
==============================================================================
--- branches/leo-ctx5/languages/tcl/TODO (original)
+++ branches/leo-ctx5/languages/tcl/TODO Fri Aug 19 00:17:05 2005
@@ -1,24 +1,20 @@
-=head1 Various
+=head1 Tcl TODOs
-=over 4
-
-=item interactive tclsh
-
-new parser breaks ability to send interactive commands to the shell, add it
-back. Even better, come up with a way to *test* the thing.
+=head2 Generic tasks
-=item PIR Tree
-
-From autrijus's talk.
-can we use this instead of the current string-based compilation.
-
-"Um, perhaps Autrijus can tell me what I meant by this." -Coke
+=over 4
=item Makefile deps
Should be more explicit about the PMC dependencies in the makefile. *something*
is causing things to get rebuilt unecessarily each time "make tclsh" is run.
+=back
+
+=head2 PIR tasks
+
+=over 4
+
=item keyed access
tcl is not using Keys when getting from aggregates. It probably should,
@@ -26,40 +22,10 @@ at least for language interoperability.
=item interactive tclsh
-Still have to:
-
o catch any real_exceptions thrown.
o respect tcl_prompt1, tcl_prompt2
o deal with incomplete input (needs better error handling)
-
-=item [interpinfo name]
-
-how to do this from inside parrot? [#36277]
-
-=item migrate all these issues to RT or TODO tests
-
-=item update docs [will]
-
-(including add pod to all .pir)
-
-=back
-
-=head1 Programming Issues
-
-=head2 C-level tasks
-
-=over 4
-
-=item string to list
-
-TclList's new_from_string method should use the string to list code
-...except that it turnsout this is non-trivial.
-
-=back
-
-=head2 PIR-level tasks
-
-=over 4
+ o add back in support for dispatch to shell.
=item implement default globals, etc.
@@ -71,18 +37,7 @@ source per-user settings. L<tclsh>
=back
-=head2 Tests
-
-We should be using the tcl-test target as our language goal. For now, keep
-enough tests in our local test harness (C<t/>) so that we don't get any
-regressions. (Running the tcl test suite takes a while). This means we
-can get by with basic tests in C<t/> for now.
-
-Long term goal would be to remove any tests in C<t/> that are testing things
-that are already tested in tcl. Partcl's checked in test suite should just
-be checking partcl-specific functionaliity.
-
-=head1 Uncategorized Issues
+=head2 Design tasks
=over 4
@@ -90,9 +45,13 @@ be checking partcl-specific functionalii
Perhaps via [namespace import]? Can fake it right now with [inline]
-=item multiple level lists
+=back
+
+=head2 refactoring tasks
+
+=over 4
-=item [expr]
+=item [expr] mdiep is currently working on this.
Clean up [expr]. MUUUUCH room for improvement there. [expr] is the source
of most of our abysmal performance in bench.tcl.
@@ -108,11 +67,7 @@ The type indicator is also used to disam
from operands. We can easily remove it for operands, but how to cleanly
remove this for operators?
-TBD: strings, floats as operands - (many of the math funcs return floats
-but you can't specify them, and not everything takes them
-(try, for example, [expr sin(1) + sin(1)] vs [expr sin(1) * sin(1)].)
-
-TBD: blocks, commands, and strings as operands
+TBD: blocks and strings as operands
TBD: logical binary ops & ternary op (need deferred evaluation) ; unary ops;
ops that work on strings only.
@@ -124,9 +79,30 @@ to get any that require int-only args, a
even if we cannot specify them. This is all supportable by MMD - we just
need to specify the correct errors to throw.
+=back
+
+=head2 Things we can't do yet (need parrot)
+
+=over 4
+
=item [pwd]
-need parrot support for this.
+Need to open an RT ticket on this.
+
+=item [interpinfo name] [#36277]
+
+how to do this from inside parrot? Design issue: what's the right
+answer? if we're called as C<parrot tcl.pbc foo.tcl>, do we report just
+C<parrot>, or C<parrot tcl.pbc> ?
+
+=item [split]
+
+There's already a split opcode that should do most of what we need, except
+it's not quite finished yet.
+
+=item [after], [vwait]
+
+pending the event system thunk.
=back
Modified: branches/leo-ctx5/languages/tcl/classes/tclfloat.pmc
==============================================================================
--- branches/leo-ctx5/languages/tcl/classes/tclfloat.pmc (original)
+++ branches/leo-ctx5/languages/tcl/classes/tclfloat.pmc Fri Aug 19
00:17:05 2005
@@ -53,6 +53,10 @@ pmclass TclFloat extends TclObject exten
buff->bufused = buflen;
return buff;
}
+
+ METHOD PMC* interpret() {
+ return SELF;
+ }
}
Modified: branches/leo-ctx5/languages/tcl/classes/tclint.pmc
==============================================================================
--- branches/leo-ctx5/languages/tcl/classes/tclint.pmc (original)
+++ branches/leo-ctx5/languages/tcl/classes/tclint.pmc Fri Aug 19 00:17:05 2005
@@ -43,6 +43,10 @@ pmclass TclInt extends TclObject extends
return dest;
}
}
+
+ METHOD PMC* interpret() {
+ return SELF;
+ }
}
Modified: branches/leo-ctx5/languages/tcl/docs/howto.pod
==============================================================================
--- branches/leo-ctx5/languages/tcl/docs/howto.pod (original)
+++ branches/leo-ctx5/languages/tcl/docs/howto.pod Fri Aug 19 00:17:05 2005
@@ -53,10 +53,16 @@ a PMC object - this would I<possibly> gi
=item features
-We're currently missing a lot of stuff that requires support from parrot
-before we can continue, like Unicode for the C<\u> escapes. I've tried to
-start documenting these in the TODO with sections like C<given Unicode>,
-then listing the things that we can do once we have that.
+We're currently missing some things that require support from parrot
+before we can continue, like [info nameofexecutable]. In general, though,
+a lot of what we need to do is possible with parrot.
+
+If you're looking for something to todo, check one of: TODO tests in
+C<t/>; RT
+https://rt.perl.org/rt3/NoAuth/parrot/List.html?Field=Lang&Value=tcl
+or by their absence: every actual builtin at
+http://www.tcl.tk/man/tcl8.5/TclCmd/contents.htm
+should have a corresponding file in C<lib/commands/>
=back
@@ -64,7 +70,7 @@ then listing the things that we can do o
=over 4
-=item pod
+=item pod
Every PIR .sub that's defined should probably have some POD to go along
with it to document the arguments and return values.
@@ -96,18 +102,23 @@ any valid PMC. Note - right now, if ther
a new string-like PMC and put the error condition in it. Eventually this
will be some kind of structure.
-Once you write a command (or add a subcommand), you need to add a test file (
-or a test in an existing) file in C<t/> - tests for C<puts>, for example,
+Before adding new functionality, add a test (or a test in an existing) file
+in C<t/> - tests for C<puts>, for example,
go in C<t/cmd_puts.t> - we use the C<Test::Harness> framework, via
-C<Parrot::Test>. To run your test, just say C<make test> in the top level
-tcl directory. Be sure to test each of the subcommands. While our eventual
-goal is to pass the tcl test suite, we really need to maintain a good one
-on our own in the meantime.
+C<Parrot::Test>.
-To find a command to work on, just check out the TODO - several commands
-are currently not implemented, and others are missing various subcommands.
+Our final goal will be to pass (most of) the tcl test suite: run
+C<make tcl-test> to checkout the latest version of of the tcl test suite
+and run it. Warning: slow...
+
+Long term goal is remove any tests in C<t/> that are testing things
+that are already tested in the official tcl suite.
+Partcl's checked in test suite should just
+be checking partcl-specific functionaliity.
=back
+
+
=cut
Modified: branches/leo-ctx5/languages/tcl/docs/overview.pod
==============================================================================
--- branches/leo-ctx5/languages/tcl/docs/overview.pod (original)
+++ branches/leo-ctx5/languages/tcl/docs/overview.pod Fri Aug 19 00:17:05 2005
@@ -52,7 +52,7 @@ This is roughly equivalent to C<tclsh> -
(currently, the name of the file you wish to parse), and reads in the file,
and uses the tcl library to parse those contents as tcl.
-=back 4
+=back
=head1 TESTS
Modified: branches/leo-ctx5/languages/tcl/lib/commands/info.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/commands/info.pir (original)
+++ branches/leo-ctx5/languages/tcl/lib/commands/info.pir Fri Aug 19
00:17:05 2005
@@ -1,6 +1,6 @@
=head2 [incr]
- Provide introspection about the tcl interpreter. (And by extension, parrot.)
+ Provide introspection about the tcl interpreter. (And by extension, parrot.)
=cut
@@ -12,32 +12,37 @@
.local pmc retval
.local int argc
- argc = argv
- unless argc goto bad_subcommand
+ argc = argv
+ unless argc goto bad_args
.local string subcommand_name
subcommand_name = shift argv
.local pmc subcommand_proc
null subcommand_proc
-
+
push_eh catch
subcommand_proc = find_global "_Tcl\0builtins\0info", subcommand_name
resume:
- clear_eh
- if_null subcommand_proc, bad_args
+ clear_eh
+ if_null subcommand_proc, bad_subcommand
.return subcommand_proc(argv)
catch:
goto resume
-bad_args:
+bad_subcommand:
retval = new String
retval = "bad option \""
retval .= subcommand_name
- retval .= "\": must be args, body, cmdcount, commands, complete, default,
exists, functions, globals, hostname, level, library, loaded, locals,
nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or
vars\n"
+ retval .= "\": must be args, body, cmdcount, commands, complete, default,
exists, functions, globals, hostname, level, library, loaded, locals,
nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or
vars"
.return(TCL_ERROR,retval)
+
+bad_args:
+ retval = new String
+ retval = "wrong # args: should be \"info option ?arg arg ...?\""
+ .return(TCL_ERROR,retval)
.end
.namespace [ "_Tcl\0builtins\0info" ]
@@ -67,9 +72,8 @@ no_args:
bad_args:
retval = new String
- retval = "wrong # args: should be \"info args procname\"\n"
- .return (TCL_ERROR,retval)
-
+ retval = "wrong # args: should be \"info args procname\""
+ .return (TCL_ERROR,retval)
.end
.sub "body"
@@ -82,7 +86,7 @@ bad_args:
.local pmc retval
.local string procname
- procname = shift argv
+ procname = argv[0]
$P1 = find_global "_Tcl", "proc_body"
$P2 = $P1[procname]
if_null $P2, no_body
@@ -93,39 +97,56 @@ no_body:
retval = "\""
retval .= procname
retval .= "\" isn't a procedure"
- .return (TCL_OK,retval)
-
+ .return (TCL_ERROR,retval)
+
bad_args:
retval = new String
- retval = "wrong # args: should be \"info body procname\"\n"
- .return (TCL_ERROR,retval)
+ retval = "wrong # args: should be \"info body procname\""
+ .return (TCL_ERROR,retval)
.end
-# XXX not dealing with ?pattern? right now..
.sub "functions"
.param pmc argv
- .local pmc math_funcs,iterator,retval
.local int argc
argc = argv
- if argc != 0 goto bad_args
+ if argc > 1 goto bad_args
+
+ .local pmc math_funcs,iterator,retval
math_funcs = find_global "_Tcl", "functions"
iterator = new Iterator, math_funcs
iterator = 0
- retval = new TclList
+ retval = new .TclList
+
+ if argc == 0 goto loop
+ .local pmc globber,rule,match
+ globber = find_global "PGE", "glob"
+ $S1 = argv[0]
+ rule = globber($S1)
+pattern_loop:
+ $S0 = shift iterator
+ match = rule($S0)
+ unless match goto pattern_next
+ $P0 = new TclString
+ $P0 = $S0
+ push retval, $P0
+pattern_next:
+ if iterator goto pattern_loop
+ .return(TCL_OK,retval)
loop:
$S0 = shift iterator
- push retval, $S0
+ $P0 = new TclString
+ $P0 = $S0
+ push retval, $P0
if iterator goto loop
-
- .return(TCL_OK,retval)
+ .return(TCL_OK,retval)
bad_args:
retval = new String
retval = "wrong # args: should be \"info functions ?pattern?\""
- .return (TCL_ERROR,retval)
+ .return (TCL_ERROR,retval)
.end
.sub "exists"
@@ -136,15 +157,18 @@ bad_args:
if argc != 1 goto bad_args
.local string varname
- varname = shift argv
+ varname = argv[0]
+
.local pmc value,retval
null value
- retval = new TclInt
+
push_eh global_catch
- $P1 = find_global "Tcl", varname
+ value = find_global "Tcl", varname
global_resume:
- clear_eh
- if_null $P1, lex
+ clear_eh
+ if_null value, lex
+found_global:
+ retval = new TclInt
retval = 1
.return(TCL_OK,retval)
@@ -155,10 +179,12 @@ lex:
$P1 = find_global "_Tcl", "call_level"
$I1 = $P1
push_eh lex_catch
- $P1 = find_lex $I1, varname
+ value = find_lex $I1, varname
lex_resume:
- clear_eh
- if_null $P1, nope
+ clear_eh
+ if_null value, nope
+found_lex:
+ retval = new TclInt
retval = 1
.return(TCL_OK,retval)
@@ -166,17 +192,30 @@ lex_catch:
goto lex_resume
nope:
+ retval = new TclInt
retval = 0
.return(TCL_OK,retval)
bad_args:
retval = new String
- retval = "wrong # args: should be \"info exists varName\"\n"
- .return (TCL_ERROR,retval)
+ retval = "wrong # args: should be \"info exists varName\""
+ .return (TCL_ERROR,retval)
.end
-#XXX no error handling yet.
.sub "tclversion"
- $P1 = find_global "Tcl", "tcl_version"
- .return(TCL_OK,$P1)
+ .param pmc argv
+
+ .local int argc
+ argc = argv
+
+ if argc != 0 goto bad_args
+
+ $P1 = find_global "Tcl", "$tcl_version"
+ .return(TCL_OK,$P1)
+
+bad_args:
+ $P1 = new String
+ $P1 = "wrong # args: should be \"info tclversion\""
+ .return (TCL_ERROR, $P1)
+
.end
Modified: branches/leo-ctx5/languages/tcl/lib/expression.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/expression.pir (original)
+++ branches/leo-ctx5/languages/tcl/lib/expression.pir Fri Aug 19 00:17:05 2005
@@ -56,6 +56,7 @@ chunk_loop:
if $I0 == 1 goto get_number
$I0 = ord expr, chunk_start
+ if $I0 == 91 goto subcommand # [
if $I0 == 40 goto get_parenthetical # (
if $I0 == 36 goto get_variable # $
if $I0 == 46 goto get_number # .
@@ -110,10 +111,6 @@ get_paren_done:
get_variable:
(retval, chunk_start) = parse_variable(expr, chunk_start)
- $P0 = retval."interpret"()
- $I0 = $P0
- retval = new TclInt
- retval = $I0
chunk = new TclList
chunk[0] = OPERAND
@@ -122,8 +119,17 @@ get_variable:
dec chunk_start
goto chunk_loop
+subcommand:
+ (retval, chunk_start) = get_subcommand(expr, chunk_start)
+
+ chunk = new TclList
+ chunk[0] = OPERAND
+ chunk[1] = retval
+ push chunks, chunk
+ dec chunk_start
+ goto chunk_loop
+
get_function:
- #print "GET_FUNC\n"
# Does the string of characters here match one of our pre-defined
# functions? If so, put that function on the stack.
.local pmc func
@@ -142,11 +148,9 @@ get_function:
goto chunk_loop
get_number:
- #print "GET_NUMBER\n"
# If we got here, then char and chunk_start are already set properly
.local pmc value
(op_length,value) = __expr_get_number(expr,chunk_start)
- #print "GOT_NUMBER\n"
if op_length == 0 goto get_operator
# XXX otherwise, pull that number off
# stuff the chunk onto the chunk_list
@@ -159,7 +163,6 @@ get_number:
goto chunk_loop
get_operator:
- #print "GET_OPERATOR\n"
# If we got here, then char and chunk_start are already set properly
.local int op_len
.local int expr_len
@@ -250,7 +253,6 @@ chunks_done:
.return(TCL_OK,chunks)
pre_converter_loop:
- #print "pre_converter_loop\n"
.local int precedence_level
precedence_level = -1 # start with functions
converter_loop:
@@ -275,7 +277,6 @@ is_opfunc:
if $I3 != precedence_level goto converter_next
right_arg:
- #print "right_arg\n"
$I2 = stack_index + 1
if $I2 >= input_len goto left_arg
retval = chunks[$I2]
@@ -290,7 +291,6 @@ right_arg:
# XXX we just deal with binary args at the moment.
left_arg:
- #print "left_arg\n"
$I2 = stack_index - 1
if $I2 < 0 goto shift_op
retval = chunks[$I2]
@@ -300,23 +300,19 @@ left_arg:
program_stack = unshift retval
shift_op:
- #print "shift_op\n"
program_stack = unshift our_op
chunks[stack_index] = undef
converter_next:
- #print "conveter_next\n"
inc stack_index
goto converter_loop
precedence_done:
- #print "precedence done\n"
inc precedence_level
stack_index = 0
goto converter_loop
die_horribly:
- #print "dying horribly\n"
return_type = TCL_ERROR
program_stack = new String
program_stack = "An error occurred in EXPR"
@@ -329,9 +325,7 @@ premature_end:
program_stack .= expr
program_stack .= "\": premature end of expression"
-converter_done:
- #print "converter done\n"
- #_dumper(program_stack,"PROG_STACK")
+converter_done:
.return(return_type,program_stack)
.end
@@ -363,25 +357,19 @@ stack_evaluator:
# move all non op non funcs to the value stack
if type == OP goto do_op
if type == FUNC goto do_op
+ $P0 = chunk[1]
+ $P0 = $P0."interpret"()
+ chunk[1] = $P0
push result_stack, chunk
goto stack_evaluator
do_op:
- #print "it's an op?\n"
# right now, we assume binary ops. Later, each op will define the
# number of and type of ops it takes, and we will respect it.
.local int func
func = chunk[1]
- #print "DO_OP: "
- #print func
- #print "\n"
-
- # XXX protect against unknown operands...
- #typeof $I0, func
- #if $I0 == .Undef goto die_horribly
-
# XXX assume all operands take two args.
.local pmc r_arg
.local pmc l_arg
@@ -389,24 +377,10 @@ do_op:
op_result = new TclInt
l_arg = pop result_stack
l_arg = l_arg[1]
- $S0 = typeof l_arg
- #print "l-arG (type):"
- #print $S0
- #print "\n"
- #print "l-arG:"
- #print l_arg
- #print "\n"
if func >= FUNCTION_ABS goto func_list
r_arg = pop result_stack
r_arg = r_arg[1]
- $S0 = typeof r_arg
- #print "r-arG (type):"
- #print $S0
- #print "\n"
- #print "r-arG:"
- #print r_arg
- #print "\n"
# Is there a more efficient way to do this dispatch?
if func == OPERATOR_MUL goto op_mul
@@ -593,25 +567,14 @@ func_tanh:
# fallthrough to done_op
done_op:
- $S0 = typeof op_result
- #print $S0
- #print "\n"
- #print "-<\n"
- #print "DID OP:"
- #print func
- #print "\n"
$P5 = new FixedPMCArray
$P5 = 2
$P5[0] = OPERAND
$P5[1] = op_result
push result_stack, $P5
- #if $I0 != TCL_ERROR goto stack_evaluator
# Ignoring exceptions for now.
goto stack_evaluator
-
- #pop retval, result_stack
- #goto evaluation_done
stack_done:
$I0 = result_stack
Modified: branches/leo-ctx5/languages/tcl/lib/tclconst.pir
==============================================================================
--- branches/leo-ctx5/languages/tcl/lib/tclconst.pir (original)
+++ branches/leo-ctx5/languages/tcl/lib/tclconst.pir Fri Aug 19 00:17:05 2005
@@ -16,7 +16,7 @@ Define the attributes required for the c
=cut
.sub __class_init @LOAD
- $P0 = getclass "TclString"
+ $P0 = getclass "String"
$P1 = subclass $P0, "TclConst"
$P0 = new Hash
Modified: branches/leo-ctx5/languages/tcl/t/cmd_break.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_break.t (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_break.t Fri Aug 19 00:17:05 2005
@@ -3,6 +3,10 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 2;
+use vars qw($TODO);
+
+TODO: {
+local $TODO = 'broken because $a returns a TclConst and not a number';
language_output_is("tcl",<<'TCL',<<OUT,"break from for");
for {set a 0} {$a < 20} {incr a} {
@@ -23,3 +27,6 @@ language_output_is("tcl",<<'TCL',<<OUT,"
TCL
9
OUT
+
+}
+
Modified: branches/leo-ctx5/languages/tcl/t/cmd_continue.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_continue.t (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_continue.t Fri Aug 19 00:17:05 2005
@@ -3,6 +3,10 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 2;
+use vars qw($TODO);
+
+TODO: {
+local $TODO = 'broken because $a returns a TclConst and not a number';
language_output_is("tcl",<<'TCL',<<OUT,"continue from for");
for {set a 0} {$a < 10} {incr a} {
@@ -40,3 +44,6 @@ TCL
--
11
OUT
+
+}
+
Modified: branches/leo-ctx5/languages/tcl/t/cmd_expr.t
==============================================================================
--- branches/leo-ctx5/languages/tcl/t/cmd_expr.t (original)
+++ branches/leo-ctx5/languages/tcl/t/cmd_expr.t Fri Aug 19 00:17:05 2005
@@ -254,25 +254,26 @@ TCL
syntax error in expression "(": premature end of expression
OUT
-language_output_is("tcl",<<'TCL',<<'OUT',"braced operands.");
- set n 1
- puts [expr {$n * 1}]
-TCL
-1
-OUT
-
language_output_is("tcl",<<'TCL',<<'OUT',"float division");
puts [expr 1 / 3.0]
TCL
0.333333333333
OUT
-TODO: {
-local $TODO = "bugs";
-
language_output_is("tcl",<<'TCL',<<'OUT',"nested expr (braces)");
puts [expr {2 * [expr {2 - 1}]}];
TCL
2
OUT
+
+TODO: {
+local $TODO = "bugs";
+
+language_output_is("tcl",<<'TCL',<<'OUT',"braced operands.");
+ set n 1
+ puts [expr {$n * 1}]
+TCL
+1
+OUT
+
}
Modified: branches/leo-ctx5/languages/tcl/tcl.pl
==============================================================================
--- branches/leo-ctx5/languages/tcl/tcl.pl (original)
+++ branches/leo-ctx5/languages/tcl/tcl.pl Fri Aug 19 00:17:05 2005
@@ -41,7 +41,7 @@ foreach my $file (@macro_includes, @cmd_
$includes .= " .include \"languages/tcl/$file\"\n";
}
-=head2 rules
+=head1 rules
Generate the PIR code that matches the various rules we have.
Modified: branches/leo-ctx5/t/op/number.t
==============================================================================
--- branches/leo-ctx5/t/op/number.t (original)
+++ branches/leo-ctx5/t/op/number.t Fri Aug 19 00:17:05 2005
@@ -16,7 +16,7 @@ Tests the use of Parrot's floating-point
=cut
-use Parrot::Test tests => 39;
+use Parrot::Test tests => 40;
use Test::More;
output_is(<<CODE, <<OUTPUT, "set_n_nc");
@@ -1076,5 +1076,14 @@ CODE
0.500000
OUTPUT
-1;
+output_is(<<'CODE', <<OUTPUT, "sqrt_n_n");
+ set N1, 2
+ sqrt N2, N1
+ print N2
+ print "\n"
+ end
+CODE
+1.414214
+OUTPUT
+
