Author: coke
Date: Fri Aug 5 09:39:58 2005
New Revision: 8823
Modified:
trunk/languages/tcl/lib/commands/string.pir
trunk/languages/tcl/t/cmd_string.t
Log:
tcl: add [string bytelength] and tests.
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 09:39:58 2005
@@ -119,12 +119,34 @@ done:
.return (return_type, retval)
.end
+.include "stringinfo.pasm"
+.sub "bytelength"
+ .param pmc argv
+
+ .local pmc retval
+ .local int argc
+ argc = argv
+ if argc != 1 goto bad_length
+ $S0 = argv[0]
+ $I0 = stringinfo $S0, .STRINGINFO_BUFUSED
+ retval = new Integer
+ retval = $I0
+ .return(TCL_OK, retval)
+
+bad_length:
+ retval = new String
+ retval = "wrong # args: should be \"string bytelength string\""
+ .return (TCL_ERROR,retval)
+.end
+
.sub "length"
.param pmc argv
.local pmc retval
+ .local int argc
+ argc = argv
+ if argc != 1 goto bad_length
- if argv != 1 goto bad_length
$S1 = argv[0]
$I0 = length $S1
retval = new Integer
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 09:39:58 2005
@@ -2,7 +2,7 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 38;
+use Parrot::Test tests => 44;
use Test::More;
use vars qw($TODO);
@@ -124,12 +124,19 @@ TCL
wrong # args: should be "string length string"
OUT
-language_output_is("tcl",<<TCL,<<OUT,"length, simple");
+language_output_is("tcl",<<TCL,<<OUT,"length, ascii");
puts [string length 10]
TCL
2
OUT
+language_output_is("tcl",<<'TCL',<<OUT,"length, unicode");
+ set a \u6666
+ puts [string length $a]
+TCL
+1
+OUT
+
language_output_is("tcl",<<TCL,<<OUT,"length, empty");
puts [string length ""]
TCL
@@ -244,3 +251,33 @@ language_output_is("tcl",<<TCL,<<OUT,"st
TCL
wrong # args: should be "string repeat string count"
OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"string bytelength: no args");
+ string bytelength
+TCL
+wrong # args: should be "string bytelength string"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"string bytelength: too many args");
+ string bytelength a b
+TCL
+wrong # args: should be "string bytelength string"
+OUT
+
+language_output_is("tcl",<<TCL,<<OUT,"string bytelength: ascii");
+ puts [string bytelength hi]
+TCL
+2
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string bytelength: unicode 1");
+ puts [string bytelength \u6666]
+TCL
+3
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string bytelength: unicode 2");
+ puts [string bytelength \u666]
+TCL
+2
+OUT
