Author: coke
Date: Fri Aug 5 07:58:19 2005
New Revision: 8820
Added:
trunk/languages/tcl/lib/string.pir
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/tcl.in
trunk/languages/tcl/lib/commands/string.pir
trunk/languages/tcl/t/cmd_string.t
Log:
Refactor tcl's [string] to use subcommand dispatch,
move all the string utility methods out of the builtin definition,
update all the tests to a more sane style,
add a new test.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Fri Aug 5 07:58:19 2005
@@ -1423,6 +1423,7 @@ languages/tcl/lib/list_to_string.pir
languages/tcl/lib/macros/is_space.pir [tcl]
languages/tcl/lib/parser.pir [tcl]
languages/tcl/lib/string_to_list.pir [tcl]
+languages/tcl/lib/string.pir [tcl]
languages/tcl/lib/tclcommand.pir [tcl]
languages/tcl/lib/tclconst.pir [tcl]
languages/tcl/lib/tclvar.pir [tcl]
Modified: trunk/config/gen/makefiles/tcl.in
==============================================================================
--- trunk/config/gen/makefiles/tcl.in (original)
+++ trunk/config/gen/makefiles/tcl.in Fri Aug 5 07:58:19 2005
@@ -67,6 +67,7 @@ lib${slash}list_to_string.pir \
lib${slash}macros${slash}is_space.pir \
lib${slash}parser.pir \
lib${slash}string_to_list.pir \
+lib${slash}string.pir \
lib${slash}tcl.p6r \
lib${slash}variables.pir \
tcl.pir_template \
Modified: trunk/languages/tcl/lib/commands/string.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/string.pir (original)
+++ trunk/languages/tcl/lib/commands/string.pir Fri Aug 5 07:58:19 2005
@@ -4,40 +4,69 @@
.namespace [ "Tcl" ]
.sub "&string"
- .local pmc argv
+ .local pmc argv, retval
argv = foldup
- .local int argc
- argc = argv
+ unless I3 goto no_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\0string", subcommand_name
+resume:
+ clear_eh
+ isnull subcommand_proc, bad_args
+ .return subcommand_proc(argv)
+
+catch:
+ goto resume
+
+bad_args:
+ retval = new String
+
+ retval = "bad option \""
+ retval .= subcommand_name
+ retval .= "\": must be bytelength, compare, equal, first, index, is, last,
length, map, match, range, repeat, replace, tolower, toupper, totitle, trim,
trimleft, trimright, wordend, or wordstart"
+
+ .return(TCL_ERROR,retval)
+
+no_args:
+ retval = new String
+ retval = "wrong # args: should be \"string option arg ?arg ...?\""
+ .return (TCL_ERROR, retval)
+
+.end
+
+.namespace [ "_Tcl\0builtins\0string" ]
+.sub "first"
+ .param pmc argv
+
+ .local int argc
.local int return_type
- return_type = TCL_OK
.local pmc retval
- .local string command
- .local pmc string_index
- string_index = find_global "_Tcl", "__string_index"
+ return_type = TCL_OK
- if argc == 0 goto noargs
- command = argv[0]
- if command == "first" goto first
- if command == "index" goto index
- if command == "length" goto length
- if command == "match" goto match
- if command == "range" goto range
- if command == "repeat" goto repeat
- goto badargs
-
-first:
- if argv > 4 goto bad_first
- if argv < 3 goto bad_first
- $S1 = argv[1]
- $S2 = argv[2]
+ argc = argv
+ if argv > 3 goto bad_args
+ if argv < 2 goto bad_args
+ $S1 = argv[0]
+ $S2 = argv[1]
$I0 = 0
- if argv == 3 goto first_do
- $S3 = argv[3]
+ if argc == 2 goto first_do
+ $S3 = argv[2]
+ .local pmc string_index
+ string_index = find_global "_Tcl", "__string_index"
(return_type,retval) = string_index($S3,$S2)
- if return_type == TCL_ERROR goto done
+ if return_type != TCL_ERROR goto first_all
+
+ .return(return_type,retval)
+
+first_all:
$I0 = retval
first_do:
@@ -45,21 +74,25 @@ first_do:
index_1 = index $S2, $S1, $I0
retval = new Integer
retval = index_1
- goto done
+ .return(TCL_OK,retval)
-bad_first:
+bad_args:
retval = new String
retval = "wrong # args: should be \"string first subString string
?startIndex?\""
- return_type = TCL_ERROR
- goto done
+ .return(TCL_ERROR,retval)
+
+.end
-index:
- # XXX without this new String, we get a test failure.
- # Shouldn't be necessary.
- #retval = new String
- if argv != 3 goto bad_index
- $S1 = argv[1]
- $S2 = argv[2]
+.sub "index"
+ .param pmc argv
+
+ .local int return_type, index_1
+ .local pmc retval
+ if argv != 2 goto bad_index
+ $S1 = argv[0]
+ $S2 = argv[1]
+ .local pmc string_index
+ string_index = find_global "_Tcl", "__string_index"
(return_type,retval) = string_index($S2,$S1)
if return_type == TCL_ERROR goto done
$I0 = retval
@@ -70,73 +103,57 @@ index:
$S0 = substr $S1, $I0, 1
retval = new String
retval = $S0
- goto done
+ .return (TCL_OK,retval)
+
index_null:
retval = new String
retval = ""
- goto done
+ .return (TCL_OK, retval)
bad_index:
retval = new String
retval = "wrong # args: should be \"string index string charIndex\""
- return_type = TCL_ERROR
- goto done
+ .return(TCL_ERROR, retval)
+
+done:
+ .return (return_type, retval)
+.end
+
+.sub "length"
+ .param pmc argv
-length:
- if argv != 2 goto bad_length
- $S1 = argv[1]
+ .local pmc retval
+
+ if argv != 1 goto bad_length
+ $S1 = argv[0]
$I0 = length $S1
retval = new Integer
retval = $I0
- goto done
+ .return(TCL_OK, retval)
bad_length:
retval = new String
retval = "wrong # args: should be \"string length string\""
- return_type = TCL_ERROR
- goto done
-
-match:
- # XXX PGE doesn't support -nocase yet, we don't either.
- # ?-nocase? pattern string
- if argc != 3 goto bad_match
-
-match_next:
- .local string pattern
- .local string the_string
-
- pattern = argv[1]
- the_string = argv[2]
-
- .local pmc globber
- globber = find_global "PGE", "glob"
-
- .local pmc rule, pir, exp
- (rule, pir, exp) = globber(pattern)
+ .return (TCL_ERROR,retval)
+.end
- .local pmc match
- match = rule(the_string)
+.sub "range"
+ .param pmc argv
- $I0 = match.__get_bool()
- retval = new TclInt
- retval = $I0
- goto done
-
-bad_match:
- retval = new TclString
- return_type = TCL_ERROR
- retval = "wrong # args: should be \"string match ?-nocase? pattern string\""
- goto done
+ .local int return_type, index_1
+ .local pmc retval
-range:
- if argv != 4 goto bad_range
- $S1 = argv[1]
- $S2 = argv[2]
- $S3 = argv[3]
+ if argv != 3 goto bad_range
+ $S1 = argv[0]
+ $S2 = argv[1]
+ $S3 = argv[2]
$I0 = length $S1
dec $I0
-
+
+ .local pmc string_index
+ string_index = find_global "_Tcl", "__string_index"
+
(return_type,retval) = string_index($S2,$S1)
if return_type == TCL_ERROR goto done
index_1 = retval
@@ -146,7 +163,7 @@ range:
$I2 = retval
range_do:
- if index_1 > $I2 goto range_null
+ if index_1 > $I2 goto done
if index_1 >= 0 goto range_top
index_1 = 0
range_top:
@@ -158,168 +175,81 @@ range_doo:
$S9 = substr $S1, index_1, $I3
retval = new String
retval = $S9
- goto done
-range_null:
- goto done
+ .return(TCL_OK, retval)
bad_range:
retval = new String
retval = "wrong # args: should be \"string range string first last\""
- return_type = TCL_ERROR
- goto done
-
-repeat:
- if argc != 3 goto bad_repeat
- .local string the_string
- .local int the_repeat
- the_string = argv[1]
- the_repeat = argv[2]
-
- #$I0 = length $S2
- # XXX - uncomment this, need to setup the sub call
- #(index_1,$I2,$P1) = __expr_get_number(the_repeat,0)
- #if $I2 != INTEGER goto bad_arg
- #if index_1 != $I0 goto bad_arg
- $I3 = the_repeat
- $S0 = repeat the_string, $I3
- retval = new String
- retval = $S0
- goto done
-
-bad_repeat:
- return_type = TCL_ERROR
- retval = new String
- retval = "wrong # args: should be \"string repeat string count\""
- goto done
-
-badargs:
- # XXX Why is this new String needed?
- retval = new String
- $S9 = "bad option \""
- $S9 .= command
- $S9 .= "\": must be bytelength, compare, equal, first, index, is, last,
length, map, match, range, repeat, replace, tolower, toupper, totitle, trim,
trimleft, trimright, wordend, or wordstart"
- retval = new String
- retval = $S9
- return_type = TCL_ERROR
- goto done
-
-noargs:
- retval = new String
- retval = "wrong # args: should be \"string option arg ?arg ...?\""
- return_type = TCL_ERROR
-
-done:
- .return(return_type,retval)
+ .return(TCL_ERROR,retval)
.end
-#
-# - string related helper subs.
-#
-
-# Given an index and a string, return an index
-# or an error
-#
-# (given an int or "end-1" style string, and a string,
-# return the actual index position)
-
-.namespace [ "_Tcl" ]
-
-.sub __string_index
- .param string position
- .param string the_string
+.sub "match"
+ .param pmc argv
- .local int return_type
- return_type = TCL_OK
+ .local int argc
+ argc = argv
.local pmc retval
- .local int index_length
- .local int number_length
- .local int number_type
- .local pmc number_result
- .local int index_1
-
- if position == "end" goto my_end
+ # XXX PGE doesn't support -nocase yet, we don't either.
+ # ?-nocase? pattern string
+ if argc != 2 goto bad_match
+
+match_next:
+ .local string pattern
+ .local string the_string
- $S0 = substr position, 0, 4
- if $S0 == "end-" goto has_end
- index_length = length $S0
- # is this an int?
- (number_length,number_type,number_result) = __expr_get_number(position,0)
- if number_type != INTEGER goto bad_arg
- if number_length != index_length goto bad_arg
- retval = number_result[1]
- goto done
-
- #if not, fail.
-bad_arg:
- # XXX We shouldn't need this String declaration here.
- retval = new String
- $S9 = "bad index \""
- $S9 .= position
- $S9 .= "\": must be integer or end?-integer?"
- retval = $S9
- return_type=TCL_ERROR
- goto done
+ pattern = argv[0]
+ the_string = argv[1]
-has_end:
- #XXX this is currently somewhat messed up.
-
- # is this an int? if so, subtract it from -1 to get our parrot-style index.
- index_length = length position
- index_length -= 4 # ignore "end-"
- # is this an int?
- (number_length,number_type,number_result) = __expr_get_number(position,4)
- if number_type != INTEGER goto bad_arg
- if number_length != index_length goto bad_arg
- # say, 1 if -1
- $I0 = number_result[1]
- # say, 2 if -2
- inc $I0
+ .local pmc globber
+ globber = find_global "PGE", "glob"
- # say, length is 6
- index_1 = length the_string
- # so, if we had end-1, then we'd be at position 4. (end is 5, -1)
- index_1 = index_1 - $I0
- retval = new Integer
- retval = index_1
-
- goto done
+ .local pmc rule, pir, exp
+ (rule, pir, exp) = globber(pattern)
+ .local pmc match
+ match = rule(the_string)
-my_end:
- $I0 = length the_string
- dec $I0
- retval = new Integer
+ $I0 = match.__get_bool()
+ retval = new TclInt
retval = $I0
-
-done:
- .return(return_type,retval)
+ .return (TCL_OK, retval)
+
+bad_match:
+ retval = new TclString
+ retval = "wrong # args: should be \"string match ?-nocase? pattern string\""
+ .return (TCL_ERROR,retval)
.end
-# Imagine how much easier this would be to do with regular
-# expressions.
-
-# Ok, now deal with the fact that they don't exist yet. (but
-# plan on probably rewriting this when they do.)
-
-#.sub __string_match
- #.param string a_pattern
- #.param string a_string
- #.param int match_case
-#
- ###if match_case == 1 goto matching
- #a_pattern = upcase a_pattern
- #a_string = upcase a_string
+.sub "repeat"
+ .param pmc argv
-#matching:
- # Special Chars
- # * (RE: .*)
- # ? (RE: .)
- # [chars] - simplified version of RE:'s [] (also sequence)
- # \x - remove any special meaning to x.
+ .local int argc
+ argc = argv
+ .local pmc retval
+ if argc != 2 goto bad_repeat
+ .local string the_string
+ .local int the_repeat
+ the_string = argv[0]
+ the_repeat = argv[1]
+
+ #$I0 = length $S2
+ # XXX - uncomment this, need to setup the sub call
+ #(index_1,$I2,$P1) = __expr_get_number(the_repeat,0)
+ #if $I2 != INTEGER goto bad_arg
+ #if index_1 != $I0 goto bad_arg
+ $I3 = the_repeat
+ $S0 = repeat the_string, $I3
+ retval = new String
+ retval = $S0
+ .return(TCL_OK, retval)
+bad_repeat:
+ retval = new String
+ retval = "wrong # args: should be \"string repeat string count\""
+ .return (TCL_ERROR, retval)
-#.end
+.end
Added: trunk/languages/tcl/lib/string.pir
==============================================================================
--- (empty file)
+++ trunk/languages/tcl/lib/string.pir Fri Aug 5 07:58:19 2005
@@ -0,0 +1,80 @@
+#
+# - string related helper subs.
+#
+
+# Given an index and a string, return an index
+# or an error
+#
+# (given an int or "end-1" style string, and a string,
+# return the actual index position)
+
+.namespace [ "_Tcl" ]
+
+.sub __string_index
+ .param string position
+ .param string the_string
+
+ .local int return_type
+ return_type = TCL_OK
+
+ .local pmc retval
+ .local int index_length
+ .local int number_length
+ .local int number_type
+ .local pmc number_result
+
+ .local int index_1
+
+ if position == "end" goto my_end
+
+ $S0 = substr position, 0, 4
+ if $S0 == "end-" goto has_end
+ index_length = length $S0
+ # is this an int?
+ (number_length,number_type,number_result) = __expr_get_number(position,0)
+ if number_type != INTEGER goto bad_arg
+ if number_length != index_length goto bad_arg
+ retval = number_result[1]
+ goto done
+
+ #if not, fail.
+bad_arg:
+ $S9 = "bad index \""
+ $S9 .= position
+ $S9 .= "\": must be integer or end?-integer?"
+ retval = new String
+ retval = $S9
+ .return (TCL_ERROR, retval)
+
+has_end:
+ # is this an int? if so, subtract it from -1 to get our parrot-style index.
+ index_length = length position
+ index_length -= 4 # ignore "end-"
+ # is this an int?
+ (number_length,number_type,number_result) = __expr_get_number(position,4)
+ if number_type != INTEGER goto bad_arg
+ if number_length != index_length goto bad_arg
+ # say, 1 if -1
+ $I0 = number_result[1]
+ # say, 2 if -2
+ inc $I0
+
+ # say, length is 6
+ index_1 = length the_string
+ # so, if we had end-1, then we'd be at position 4. (end is 5, -1)
+ index_1 = index_1 - $I0
+ retval = new Integer
+ retval = index_1
+
+ goto done
+
+
+my_end:
+ $I0 = length the_string
+ dec $I0
+ retval = new Integer
+ retval = $I0
+
+done:
+ .return(return_type,retval)
+.end
Modified: trunk/languages/tcl/t/cmd_string.t
==============================================================================
--- trunk/languages/tcl/t/cmd_string.t (original)
+++ trunk/languages/tcl/t/cmd_string.t Fri Aug 5 07:58:19 2005
@@ -2,166 +2,169 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 37;
+use Parrot::Test tests => 38;
use Test::More;
use vars qw($TODO);
-my($tcl,$expected);
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first a abcdef]
-EOTCL
-$expected = "0";
-language_output_is("tcl",$tcl,$expected,"first, initial");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first a federal]
-EOTCL
-$expected = "5";
-language_output_is("tcl",$tcl,$expected,"first, middle");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c green ]
-EOTCL
-$expected = "-1";
-language_output_is("tcl",$tcl,$expected,"first, failure");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c green 0]
-EOTCL
-$expected = "-1";
-language_output_is("tcl",$tcl,$expected,"first, index, failure");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c abcd end-3]
-EOTCL
-$expected = "2";
-language_output_is("tcl",$tcl,$expected,"first, index, end");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c abcd 20]
-EOTCL
-$expected = "-1";
-language_output_is("tcl",$tcl,$expected,"first, index, overshot");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c abcd 1]
-EOTCL
-$expected = "2";
-language_output_is("tcl",$tcl,$expected,"first, index");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first c abcd joe]
-EOTCL
-$expected = "bad index \"joe\": must be integer or end?-integer?\n";
-language_output_is("tcl",$tcl,$expected,"first, index, invalid index");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first]
-EOTCL
-$expected = "wrong # args: should be \"string first subString string
?startIndex?\"\n";
-language_output_is("tcl",$tcl,$expected,"first, too few args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string first a b c d]
-EOTCL
-$expected = "wrong # args: should be \"string first subString string
?startIndex?\"\n";
-language_output_is("tcl",$tcl,$expected,"first, too many args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string index a b c]
-EOTCL
-$expected = "wrong # args: should be \"string index string charIndex\"\n";
-language_output_is("tcl",$tcl,$expected,"index, too many args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string index]
-EOTCL
-$expected = "wrong # args: should be \"string index string charIndex\"\n";
-language_output_is("tcl",$tcl,$expected,"index, too few args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string index abcde 0]
-EOTCL
-$expected = "a";
-language_output_is("tcl",$tcl,$expected,"index, initial");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string index abcde end]
-EOTCL
-$expected = "e";
-language_output_is("tcl",$tcl,$expected,"index, end");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string index abcde 10]
-EOTCL
-$expected = "";
-language_output_is("tcl",$tcl,$expected,"index, too far");
+language_output_is("tcl",<<TCL,<<OUT,"first, initial");
+ string
+TCL
+wrong # args: should be "string option arg ?arg ...?"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, initial");
+ puts [string first a abcdef]
+TCL
+0
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, middle");
+ puts [string first a federal]
+TCL
+5
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, failure");
+ puts [string first c green]
+TCL
+-1
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, index, failure");
+ puts [string first c green 0]
+TCL
+-1
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, index, end");
+ puts [string first c abcd end-3]
+TCL
+2
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, index, overshot");
+ puts [string first c abcd 20]
+TCL
+-1
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, index");
+ puts [string first c abcd 1]
+TCL
+2
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, index, invalid index");
+ puts [string first c abcd joe]
+TCL
+bad index "joe": must be integer or end?-integer?
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, not enough args");
+ string first
+TCL
+wrong # args: should be "string first subString string ?startIndex?"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"first, too many args");
+ string first a b c d
+TCL
+wrong # args: should be "string first subString string ?startIndex?"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"index, too many args");
+ string index a b c
+TCL
+wrong # args: should be "string index string charIndex"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"index, too few args");
+ string index
+TCL
+wrong # args: should be "string index string charIndex"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"index, initial");
+ puts [string index abcde 0]
+TCL
+a
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"index, end");
+ puts [string index abcde end]
+TCL
+e
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"index, overshot");
+ puts [string index abcde 10]
+TCL
+OUT
TODO: {
-local $TODO = "don't handle negative indices yet.";
-$tcl = <<'EOTCL';
- puts -nonewline [string index abcde -1]
-EOTCL
-$expected = "";
-language_output_is("tcl",$tcl,$expected,"index, too near?");
-}
+local $TODO="__string_index can't handle negative numbers yet.";
+language_output_is("tcl",<<TCL,<<OUT,"index, undershot");
+ puts [string index abcde -1]
+TCL
+
+OUT
+}
-$tcl = <<'EOTCL';
- puts -nonewline [string length a b]
-EOTCL
-$expected = "wrong # args: should be \"string length string\"\n";
-language_output_is("tcl",$tcl,$expected,"length, too many args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string length]
-EOTCL
-$expected = "wrong # args: should be \"string length string\"\n";
-language_output_is("tcl",$tcl,$expected,"length, too few args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string length 10]
-EOTCL
-$expected = "2";
-language_output_is("tcl",$tcl,$expected,"length, simple");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string length ""]
-EOTCL
-$expected = "0";
-language_output_is("tcl",$tcl,$expected,"length, simple");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string range a b]
-EOTCL
-$expected = "wrong # args: should be \"string range string first last\"\n";
-language_output_is("tcl",$tcl,$expected,"range, too many args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string range a b c d]
-EOTCL
-$expected = "wrong # args: should be \"string range string first last\"\n";
-language_output_is("tcl",$tcl,$expected,"range, too few args");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string range abcde 0 end]
-EOTCL
-$expected = "abcde";
-language_output_is("tcl",$tcl,$expected,"range, total");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string range abcde 1 end-1]
-EOTCL
-$expected = "bcd";
-language_output_is("tcl",$tcl,$expected,"range, partial");
-
-$tcl = <<'EOTCL';
- puts -nonewline [string range abcde end-20 20]
-EOTCL
-$expected = "abcde";
-language_output_is("tcl",$tcl,$expected,"range, overextended");
+language_output_is("tcl",<<TCL,<<OUT,"length, too many args");
+ puts [string length a b]
+TCL
+wrong # args: should be "string length string"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"length, too few args");
+ string length
+TCL
+wrong # args: should be "string length string"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"length, simple");
+ puts [string length 10]
+TCL
+2
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"length, empty");
+ puts [string length ""]
+TCL
+0
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"range, too many args");
+ string range a b c d
+TCL
+wrong # args: should be "string range string first last"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"range, too few args");
+ string range
+TCL
+wrong # args: should be "string range string first last"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"range, total");
+ puts [string range abcde 0 end]
+TCL
+abcde
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"range, partial");
+ puts [string range abcde 1 end-1]
+TCL
+bcd
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"range, overextended");
+ puts [string range abcde end-20 20]
+TCL
+abcde
+OUT
language_output_is("tcl",<<TCL,<<OUT,"string match * only");
puts [string match * foo]
