# New Ticket Created by Alberto Simoes
# Please include the string: [perl #38067]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=38067 >
--
Alberto Simões - Departamento de Informática - Universidade do Minho
Campus de Gualtar - 4710-057 Braga - Portugal
Index: languages/tcl/t/cmd_string.t
===================================================================
--- languages/tcl/t/cmd_string.t (revision 10775)
+++ languages/tcl/t/cmd_string.t (working copy)
@@ -2,7 +2,8 @@
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 109;
+
+use Parrot::Test tests => 115;
use Parrot::Config;
use Test::More;
@@ -551,7 +552,43 @@
OUT
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, bad args");
+ string replace
+TCL
+wrong # args: should be "string replace string first last ?string?"
+OUT
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, simple");
+ puts [string replace parrcamelot 4 8]
+TCL
+parrot
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, negative index");
+ puts [string replace junkparrot -10 3]
+TCL
+parrot
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, index bigger than
string");
+ puts [string replace parrotjunk 6 20]
+TCL
+parrot
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, by something");
+ puts [string replace perl 1 3 arrot]
+TCL
+parrot
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"string replace, swapped indexes");
+ puts [string replace perl 3 1 arrot]
+TCL
+perl
+OUT
+
+
language_output_is("tcl",<<'TCL',<<OUT,"string trimleft, bad args");
string trimleft
TCL
@@ -630,7 +667,6 @@
abcfaoo
OUT
-
# XXX - many of the classes are NOT tested here, and we rely
# on the cvs tests from tcl for that.
Index: languages/tcl/lib/commands/string.pir
===================================================================
--- languages/tcl/lib/commands/string.pir (revision 10775)
+++ languages/tcl/lib/commands/string.pir (working copy)
@@ -712,7 +712,58 @@
bad_args:
.throw('wrong # args: should be "string is class ?-strict? ?-failindex var?
str"')
+.end
+
+.sub "replace"
+ .param pmc argv
+
+ .local int argc
+ .local int low
+ .local int high
+ .local int len
+ .local pmc retval
+
+ .local pmc string_index
+ string_index = find_global "_Tcl", "__string_index"
+
+ argc = argv
+ if argc > 4 goto bad_args
+ if argc < 3 goto bad_args
+
+ $S1 = argv[0]
+ $S4 = ""
+
+ $S2 = argv[1]
+ low = string_index($S2, $S1)
+
+ $S3 = argv[2]
+ high = string_index($S3, $S1)
+
+ if high < low goto replace_done
+
+ if low >= 0 goto low_ok
+ low = 0
+
+low_ok:
+ len = length $S1
+ if high <= len goto high_ok
+ high = len
+
+high_ok:
+ if argc == 1 goto replace_do
+ $S4 = argv[3]
+
+replace_do:
+ len = high - low
+ len += 1
+ substr $S1, low, len, $S4
+
+replace_done:
+ .return($S1)
+
+bad_args:
+ .throw ("wrong # args: should be \"string replace string first last
?string?\"")
.end
@@ -834,3 +885,4 @@
.end
+
