# New Ticket Created by Alberto Simoes
# Please include the string: [perl #38058]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=38058 >
Please validate the tests, as the meaning of the 'last' third argument
wasn't the correct in the test cases.
From tcl,
Search string2 for a sequence of characters that exactly match the
characters in string1. If found, return the index of the first character
in the last such match within string2. If there is no match, then return
-1. If lastIndex is specified (in any of the forms accepted by the index
method), then only the characters in string2 at or before the specified
lastIndex will be considered by the search.
Which means that if lastindex > length(string2), then length(string2) is
considered and no error is raised.
Cheers
Alberto
--
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 10725)
+++ languages/tcl/t/cmd_string.t (working copy)
@@ -72,9 +72,6 @@
wrong # args: should be "string first subString string ?startIndex?"
OUT
-TODO: {
- local $TODO = "implement string last";
-
language_output_is("tcl",<<TCL,<<OUT,"last, initial");
puts [string last a abcdefa]
TCL
@@ -100,21 +97,23 @@
OUT
language_output_is("tcl",<<TCL,<<OUT,"last, index, end");
- puts [string last c abcdc end-4]
+ puts [string last c abcdc end-2]
TCL
-4
+2
OUT
+## Overshot is ignored in this case as the maximum between the string
+## of the offset is considered
language_output_is("tcl",<<TCL,<<OUT,"last, index, overshot");
puts [string last c abcd 20]
TCL
--1
+2
OUT
language_output_is("tcl",<<TCL,<<OUT,"last, index");
puts [string last c abcdc 1]
TCL
-4
+-1
OUT
language_output_is("tcl",<<TCL,<<OUT,"last, index, invalid index");
@@ -126,17 +125,15 @@
language_output_is("tcl",<<TCL,<<OUT,"last, not enough args");
string last
TCL
-wrong # args: should be "string last subString string ?startIndex?"
+wrong # args: should be "string last subString string ?lastIndex?"
OUT
language_output_is("tcl",<<TCL,<<OUT,"last, too many args");
string last a b c d
TCL
-wrong # args: should be "string last subString string ?startIndex?"
+wrong # args: should be "string last subString string ?lastIndex?"
OUT
-}
-
language_output_is("tcl",<<TCL,<<OUT,"index, too many args");
string index a b c
TCL
Index: languages/tcl/lib/commands/string.pir
===================================================================
--- languages/tcl/lib/commands/string.pir (revision 10725)
+++ languages/tcl/lib/commands/string.pir (working copy)
@@ -63,6 +63,54 @@
.end
+.sub "last"
+ .param pmc argv
+
+ .local int argc
+ .local pmc retval
+
+ argc = argv
+ if argc > 3 goto bad_args
+ if argc < 2 goto bad_args
+ $S1 = argv[0]
+ $S2 = argv[1]
+
+ $I0 = length $S2
+ if argc == 2 goto last_do
+
+ $S3 = argv[2]
+ .local pmc string_index
+ string_index = find_global "_Tcl", "__string_index"
+ $I1 = string_index($S3,$S2)
+
+ if $I1 > $I0 goto last_do
+ $I0 = $I1
+
+last_do:
+ .local int index_1
+ index_1 = index $S2, $S1, 0
+ if index_1 > $I0 goto not_found
+ if index_1 < 0 goto not_found
+
+iterate:
+ $I1 = index_1
+ $I2 = $I1 + 1
+ index_1 = index $S2, $S1, $I2
+ if index_1 < 0 goto return
+ if index_1 > $I0 goto return
+ goto iterate
+
+return:
+ .return($I1)
+
+not_found:
+ .return(-1)
+
+bad_args:
+ .throw ("wrong # args: should be \"string last subString string
?lastIndex?\"")
+
+.end
+
.sub "index"
.param pmc argv
