cvsuser 01/12/30 04:04:57
Modified: . Makefile.in core.ops packfile.c pbc2c.pl string.c
classes perlstring.pmc
encodings singlebyte.c utf16.c utf32.c utf8.c
include/parrot encoding.h string.h
t/op string.t
Log:
* Expand the strings test suite to be more complete
* Make string commands more consistent (i.e, now the only string command
that actually changes the original is chopn)
* Significantly reduce the number of memory allocations and eliminate
reallocations.
Courtesy of: David Jacobs <[EMAIL PROTECTED]>
Revision Changes Path
1.86 +2 -1 parrot/Makefile.in
Index: Makefile.in
===================================================================
RCS file: /cvs/public/parrot/Makefile.in,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -w -r1.85 -r1.86
--- Makefile.in 27 Dec 2001 23:57:58 -0000 1.85
+++ Makefile.in 30 Dec 2001 12:04:56 -0000 1.86
@@ -44,7 +44,7 @@
#XXX This target is not portable to Win32
-shared: libparrot.so libcore_prederef_0_3.so
+shared: Libparrot.so libcore_prederef_0_3.so
libparrot.so: $(O_FILES)
$(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
@@ -173,6 +173,7 @@
$(RM_F) Parrot/Jit.pm
$(RM_F) include/parrot/jit_struct.h
$(RM_F) libparrot.so libcore_prederef_0_3.so
+ $(RM_F) *~
cd docs && $(MAKE) clean && cd ..
cd classes && $(MAKE) clean && cd ..
cd languages && $(MAKE) clean && cd ..
1.61 +51 -9 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- core.ops 28 Dec 2001 21:20:19 -0000 1.60
+++ core.ops 30 Dec 2001 12:04:56 -0000 1.61
@@ -104,7 +104,7 @@
op err(s) {
char *tmp = strerror(errno);
- STRING *s = string_make(interpreter, tmp, strlen(tmp), 0, 0, 0);
+ STRING *s = string_make(interpreter, tmp, strlen(tmp), NULL, 0, NULL);
$1 = s;
goto NEXT();
}
@@ -165,10 +165,10 @@
default: file = (FILE *)$2;
}
- string_grow($1, 65535);
+ $1 = string_make(interpreter, NULL, 65535, NULL, 0, NULL);
memset(($1)->bufstart, 0, 65535);
fgets(($1)->bufstart, 65534, file);
- ($1)->strlen = strlen(($1)->bufstart);
+ ($1)->strlen = ($1)->bufused = strlen(($1)->bufstart);
goto NEXT();
}
@@ -359,11 +359,10 @@
INTVAL len = $3;
string_destroy($1);
- tmp = malloc(len + 1);
- read($2, tmp, len);
- s = string_make(interpreter, tmp, len, 0, 0, 0);
+ s = string_make(interpreter, NULL, len, NULL, 0, NULL);
+ read($2, s->bufstart, len);
+ s->bufused = s->buflen;
$1 = s;
- free(tmp);
goto NEXT();
}
@@ -860,6 +859,10 @@
=item B<lt>(s, sc, ic)
+=item B<lt>(sc, s, ic)
+
+=item B<lt>(sc, sc, ic)
+
Branch if $1 is less than $2.
=cut
@@ -885,6 +888,13 @@
goto NEXT();
}
+op lt(sc, s|sc, ic) {
+ if (string_compare(interpreter, $1, $2) < 0) {
+ goto OFFSET($3);
+ }
+ goto NEXT();
+}
+
########################################
@@ -900,6 +910,10 @@
=item B<le>(s, sc, ic)
+=item B<le>(sc, s, ic)
+
+=item B<le>(sc, sc, ic)
+
Branch if $1 is less than or equal to $2.
=cut
@@ -925,6 +939,13 @@
goto NEXT();
}
+op le(sc, s|sc, ic) {
+ if (string_compare(interpreter, $1, $2) <= 0) {
+ goto OFFSET($3);
+ }
+ goto NEXT();
+}
+
########################################
@@ -940,6 +961,10 @@
=item B<gt>(s, sc, ic)
+=item B<gt>(sc, s, ic)
+
+=item B<gt>(sc, sc, ic)
+
Branch if $1 is greater than $2.
=cut
@@ -965,6 +990,13 @@
goto NEXT();
}
+op gt(sc, s|sc, ic) {
+ if (string_compare(interpreter, $1, $2) > 0) {
+ goto OFFSET($3);
+ }
+ goto NEXT();
+}
+
########################################
@@ -980,6 +1012,10 @@
=item B<ge>(s, sc, ic)
+=item B<ge>(sc, s, ic)
+
+=item B<ge>(sc, sc, ic)
+
Branch if $1 is greater than or equal to $2.
=cut
@@ -1005,6 +1041,13 @@
goto NEXT();
}
+op ge(sc, s|sc, ic) {
+ if (string_compare(interpreter, $1, $2) >= 0) {
+ goto OFFSET($3);
+ }
+ goto NEXT();
+}
+
########################################
@@ -1035,7 +1078,7 @@
}
op if (s, ic) {
- if (string_bool(interpreter, $1)) {
+ if (string_bool($1)) {
goto OFFSET($2);
}
goto NEXT();
@@ -1117,7 +1160,6 @@
$1 = $2 + $3;
goto NEXT();
}
-
########################################
1.17 +6 -3 parrot/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/packfile.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- packfile.c 6 Dec 2001 21:22:13 -0000 1.16
+++ packfile.c 30 Dec 2001 12:04:56 -0000 1.17
@@ -7,7 +7,7 @@
** This program is free software. It is subject to the same
** license as Parrot itself.
**
-** $Id: packfile.c,v 1.16 2001/12/06 21:22:13 dan Exp $
+** $Id: packfile.c,v 1.17 2001/12/30 12:04:56 simon Exp $
*/
#include "parrot/parrot.h"
@@ -1484,10 +1484,13 @@
self->type = PFC_STRING;
if (encoding == 0) {
- self->string = string_make(interpreter, cursor, size, NULL, flags, NULL);
/* fixme */
+ self->string = string_make(interpreter, cursor, size, NULL, flags,
+ NULL); /* fixme */
}
else if (encoding == 3) {
- self->string = string_make(interpreter, cursor, size,
encoding_lookup("utf32"), flags, chartype_lookup("unicode")); /* fixme */
+ self->string = string_make(interpreter, cursor, size,
+ encoding_lookup("utf32"), flags,
+ chartype_lookup("unicode")); /* fixme */
}
else {
return 0;
1.9 +3 -2 parrot/pbc2c.pl
Index: pbc2c.pl
===================================================================
RCS file: /cvs/public/parrot/pbc2c.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- pbc2c.pl 27 Dec 2001 21:18:03 -0000 1.8
+++ pbc2c.pl 30 Dec 2001 12:04:56 -0000 1.9
@@ -8,7 +8,7 @@
# This program is free software. It is subject to the same license
# as the Parrot interpreter.
#
-# $Id: pbc2c.pl,v 1.8 2001/12/27 21:18:03 gregor Exp $
+# $Id: pbc2c.pl,v 1.9 2001/12/30 12:04:56 simon Exp $
#
use strict;
@@ -123,7 +123,8 @@
$data = '"' . $data . '"' unless $data =~ m/^"/;
print <<END_C;
- c = PackFile_Constant_new_string(interpreter, string_make(interpreter, $data,
$size, $encoding, $flags, $type));
+ c = PackFile_Constant_new_string(interpreter, string_make(interpreter,
+ $data, $size, $encoding, $flags, $type));
END_C
} else {
die;
1.28 +139 -148 parrot/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- string.c 29 Dec 2001 22:12:37 -0000 1.27
+++ string.c 30 Dec 2001 12:04:56 -0000 1.28
@@ -1,7 +1,7 @@
/* string.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: string.c,v 1.27 2001/12/29 22:12:37 dan Exp $
+ * $Id: string.c,v 1.28 2001/12/30 12:04:56 simon Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -31,9 +31,10 @@
* and compute its string length
*/
STRING *
-string_make(struct Parrot_Interp *interpreter, void *buffer, INTVAL buflen,
- const ENCODING *encoding, INTVAL flags, const CHARTYPE *type) {
- STRING *s = new_string_header(interpreter);
+string_make(struct Parrot_Interp *interpreter, const void *buffer,
+ INTVAL buflen, const ENCODING *encoding, INTVAL flags,
+ const CHARTYPE *type) {
+ STRING *s;
if (!type) {
type = string_native_type;
@@ -43,27 +44,25 @@
encoding = encoding_lookup(type->default_encoding);
}
- s->bufstart = mem_sys_allocate(buflen);
- mem_sys_memcopy(s->bufstart, buffer, buflen);
+ s = mem_sys_allocate(sizeof(STRING)+buflen);
s->encoding = encoding;
- s->buflen = s->bufused = buflen;
s->flags = flags;
- string_compute_strlen(s);
s->type = type;
+ s->buflen = buflen;
- return s;
+ if (buffer) {
+ mem_sys_memcopy(s->bufstart, buffer, buflen);
+ s->bufused = buflen;
+ string_compute_strlen(s);
}
-
-/*=for api string string_grow
- * reallocate memory for the string if it is too small
- */
-void
-string_grow(STRING* s, INTVAL newsize) {
- INTVAL newsize_in_bytes = string_max_bytes(s, newsize);
- if (s->buflen < newsize_in_bytes) {
- s->bufstart = mem_sys_realloc(s->bufstart, newsize_in_bytes);
+ else {
+ s->strlen = s->bufused = 0;
}
- s->buflen = newsize_in_bytes;
+
+ /* Make it null terminate. This will simplify making a native string */
+ s->bufstart[s->bufused]='\0';
+
+ return s;
}
/*=for api string string_destroy
@@ -80,7 +79,7 @@
* return the length of the string
*/
INTVAL
-string_length(STRING* s) {
+string_length(const STRING* s) {
return s->strlen;
}
@@ -91,7 +90,7 @@
* functions are fleshed out, this function can DTRT.
*/
static INTVAL
-string_index(STRING* s, INTVAL index) {
+string_index(const STRING* s, INTVAL index) {
return s->encoding->decode(s->encoding->skip_forward(s->bufstart, index));
}
@@ -99,7 +98,7 @@
* return the length of the string
*/
INTVAL
-string_ord(STRING* s, INTVAL index) {
+string_ord(const STRING* s, INTVAL index) {
if((s == NULL) || (string_length(s) == 0)) {
INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
"Cannot get character of empty string");
@@ -129,7 +128,7 @@
* create a copy of the argument passed in
*/
STRING*
-string_copy(struct Parrot_Interp *interpreter, STRING *s) {
+string_copy(struct Parrot_Interp *interpreter, const STRING *s) {
return string_make(interpreter, s->bufstart, s->bufused, s->encoding,
s->flags, s->type);
}
@@ -138,31 +137,24 @@
* create a transcoded copy of the argument passed in
*/
STRING*
-string_transcode(struct Parrot_Interp *interpreter, STRING *src,
- const ENCODING *encoding, const CHARTYPE *type,
- STRING *dest) {
- if (!dest) {
- dest = string_make(interpreter, NULL, 0, encoding, 0, type);
- }
- else {
- dest->encoding = encoding;
- dest->type = type;
- }
-
- string_grow(dest, src->strlen);
+string_transcode(struct Parrot_Interp *interpreter,
+ const STRING *src, const ENCODING *encoding,
+ const CHARTYPE *type, STRING **dest_ptr) {
- if (src->encoding == dest->encoding && src->type == dest->type) {
- mem_sys_memcopy(dest->bufstart, src->bufstart, src->bufused);
-
- dest->bufused = src->bufused;
- }
- else {
+ STRING *dest;
CHARTYPE_TRANSCODER transcoder1 = NULL;
CHARTYPE_TRANSCODER transcoder2 = NULL;
- char *srcstart;
- char *srcend;
- char *deststart;
- char *destend;
+ void *srcstart;
+ void *srcend;
+ void *deststart;
+ void *destend;
+
+ if (src->encoding == encoding && src->type == type) {
+ return string_copy(interpreter, src);
+ }
+
+ dest = string_make(interpreter, NULL, src->strlen*src->encoding->max_bytes,
+ encoding, 0, type);
if (src->type != dest->type) {
transcoder1 = chartype_lookup_transcoder(src->type, dest->type);
@@ -174,7 +166,7 @@
}
}
- srcstart = src->bufstart;
+ srcstart = (void*)src->bufstart;
srcend = srcstart + src->bufused;
deststart = dest->bufstart;
destend = deststart + dest->buflen;
@@ -191,9 +183,12 @@
}
dest->bufused = destend - deststart;
- }
-
dest->strlen = src->strlen;
+ dest->bufstart[dest->bufused]='\0';
+
+ if (dest_ptr) {
+ *dest_ptr = dest;
+ }
return dest;
}
@@ -209,41 +204,47 @@
return s->strlen;
}
-/*=for api string string_max_bytes
- * get the maximum number of bytes needed by iv characters
- */
-INTVAL
-string_max_bytes(STRING* s, INTVAL iv) {
- return iv * s->encoding->max_bytes;
-}
-
/*=for api string string_concat
* concatenate two strings
*/
STRING*
-string_concat(struct Parrot_Interp *interpreter, STRING* a, STRING* b,
- INTVAL flags) {
- if(a != NULL) {
- if (b == NULL || b->strlen == 0) {
- return a;
- }
+string_concat(struct Parrot_Interp *interpreter, const STRING* a,
+ const STRING* b, INTVAL flags) {
+ STRING *result;
+
+ if (a != NULL && a->strlen != 0) {
+ if (b != NULL && b->strlen != 0) {
+ result = string_make(interpreter, NULL, a->bufused +
+ b->strlen*a->encoding->max_bytes,
+ a->encoding, 0, a->type);
+ mem_sys_memcopy(result->bufstart,a->bufstart,a->bufused);
if (a->type != b->type || a->encoding != b->encoding) {
b = string_transcode(interpreter, b, a->encoding, a->type, NULL);
}
- string_grow(a, a->strlen + b->strlen);
- mem_sys_memcopy((void*)((ptrcast_t)a->bufstart + a->bufused),
+ mem_sys_memcopy((void*)((ptrcast_t)result->bufstart + a->bufused),
b->bufstart, b->bufused);
- a->strlen = a->strlen + b->strlen;
- a->bufused = a->bufused + b->bufused;
+ result->strlen = a->strlen + b->strlen;
+ result->bufused = a->bufused + b->bufused;
+ result->bufstart[result->bufused]='\0';
+ }
+ else {
+ return string_copy(interpreter, a);
+ }
+ }
+ else {
+ if (a != NULL) {
+ return string_transcode(interpreter, b, a->encoding, a->type, NULL);
+ }
+ else {
+ if (b != NULL) {
+ return string_copy(interpreter, b);
}
else {
- if (b == NULL) {
- return string_make(interpreter, "", 0, 0, 0, 0);
+ return string_make(interpreter, "", 0, NULL, 0, NULL);
+ }
}
- return string_make(interpreter,
- b->bufstart,b->buflen,b->encoding,flags,b->type);
}
- return a;
+ return result;
}
/*=for api string string_repeat
@@ -251,8 +252,7 @@
* Allocates I<d> if needed, also returns d.
*/
STRING*
-string_repeat(struct Parrot_Interp *interpreter, STRING* s, INTVAL num,
- STRING** d) {
+string_repeat(struct Parrot_Interp *interpreter, const STRING* s, INTVAL num,
STRING** d) {
STRING* dest;
INTVAL i;
@@ -260,34 +260,24 @@
INTERNAL_EXCEPTION(NEG_REPEAT, "Cannot repeat with negative arg");
}
- if (!d || !*d) {
- dest = string_make(interpreter,
- NULL, 0, s->encoding,
- 0, s->type);
- }
- else {
- dest = *d;
- }
- string_grow(dest, s->strlen * num);
+ dest = string_make(interpreter, NULL, s->bufused*num, s->encoding, 0,
+ s->type);
if (num == 0) {
- dest->strlen = 0;
return dest;
}
- /* copy s into dest */
- mem_sys_memcopy(dest->bufstart, s->bufstart, s->bufused);
-
- /* copy from start of dest to later part of dest n times */
- for (i = 1; i< num; i++) {
+ /* copy s into dest num times */
+ for (i = 0; i< num; i++) {
mem_sys_memcopy((void*)((ptrcast_t)dest->bufstart+s->bufused * i),
- dest->bufstart, s->bufused);
+ s->bufstart, s->bufused);
}
- dest->type = s->type;
- dest->encoding = s->encoding;
- dest->language = s->language;
dest->bufused = s->bufused * num;
- string_compute_strlen(dest);
+ dest->strlen = s->strlen *num;
+
+ if (d != NULL) {
+ *d = dest;
+ }
return dest;
}
@@ -296,11 +286,10 @@
* Allocate memory for d if necessary.
*/
STRING*
-string_substr(struct Parrot_Interp *interpreter, STRING* src, INTVAL offset,
- INTVAL length, STRING** d) {
+string_substr(struct Parrot_Interp *interpreter, const STRING* src, INTVAL offset,
INTVAL length, STRING** d) {
STRING *dest;
- char *substart;
- char *subend;
+ void *substart;
+ void *subend;
if (offset < 0) {
offset = src->strlen + offset;
}
@@ -314,18 +303,18 @@
if (length > (src->strlen - offset) ) {
length = src->strlen - offset;
}
- if (!d || !*d) {
- dest = string_make(interpreter, NULL, 0, src->encoding, 0, src->type);
- }
- else {
- dest = *d;
- }
+ dest = string_make(interpreter, NULL, length*src->encoding->max_bytes,
+ src->encoding, 0, src->type);
substart = src->encoding->skip_forward(src->bufstart, offset);
subend = src->encoding->skip_forward(substart, length);
- string_grow(dest, length);
mem_sys_memcopy(dest->bufstart, substart, subend - substart);
dest->bufused = subend - substart;
dest->strlen = length;
+ dest->bufstart[dest->bufused]='\0';
+
+ if (d != NULL) {
+ *d = dest;
+ }
return dest;
}
@@ -334,8 +323,8 @@
*/
STRING*
string_chopn(STRING* s, INTVAL n) {
- char *bufstart = s->bufstart;
- char *bufend = bufstart + s->bufused;
+ void *bufstart = s->bufstart;
+ void *bufend = bufstart + s->bufused;
if (n > s->strlen) {
n = s->strlen;
}
@@ -345,6 +334,7 @@
bufend = s->encoding->skip_backward(bufend, n);
s->bufused = bufend - bufstart;
s->strlen = s->strlen - n;
+ s->bufstart[s->bufused] = '\0';
return s;
}
@@ -352,23 +342,24 @@
* compare two strings.
*/
INTVAL
-string_compare(struct Parrot_Interp *interpreter, STRING* s1, STRING* s2) {
- char *s1start;
- char *s1end;
- char *s2start;
- char *s2end;
+string_compare(struct Parrot_Interp *interpreter, const STRING* s1,
+ const STRING* s2) {
+ void *s1start;
+ void *s1end;
+ void *s2start;
+ void *s2end;
INTVAL cmp = 0;
if (s1->type != s2->type || s1->encoding != s2->encoding) {
- s1 =
- string_transcode(interpreter, s1, NULL, string_unicode_type, NULL);
- s2 =
- string_transcode(interpreter, s2, NULL, string_unicode_type, NULL);
+ s1 = string_transcode(interpreter, s1, NULL, string_unicode_type,
+ NULL);
+ s2 = string_transcode(interpreter, s2, NULL, string_unicode_type,
+ NULL);
}
- s1start = s1->bufstart;
+ s1start = (void*)s1->bufstart;
s1end = s1start + s1->bufused;
- s2start = s2->bufstart;
+ s2start = (void*)s2->bufstart;
s2end = s2start + s2->bufused;
while (cmp == 0 && s1start < s1end && s2start < s2end) {
@@ -388,7 +379,7 @@
}
/* A string is "true" if it is equal to anything but "" and "0" */
-BOOLVAL string_bool (struct Parrot_Interp *interpreter, STRING* s) {
+BOOLVAL string_bool (const STRING* s) {
INTVAL len;
if (s == NULL) {
return 0;
@@ -423,12 +414,12 @@
rounding towards zero.
*/
-INTVAL string_to_int (struct Parrot_Interp *interpreter, STRING *s) {
+INTVAL string_to_int (const STRING *s) {
INTVAL i = 0;
if (s) {
- char *start = s->bufstart;
- char *end = start + s->bufused;
+ void *start = (void*)s->bufstart;
+ void *end = start + s->bufused;
int sign = 1;
BOOLVAL in_number = 0;
@@ -461,12 +452,12 @@
return i;
}
-FLOATVAL string_to_num (struct Parrot_Interp *interpreter, STRING *s) {
+FLOATVAL string_to_num (const STRING *s) {
FLOATVAL f = 0.0;
if (s) {
- char *start = s->bufstart;
- char *end = start + s->bufused;
+ void *start = (void*)s->bufstart;
+ void *end = start + s->bufused;
int sign = 1;
BOOLVAL seen_dot = 0;
BOOLVAL seen_e = 0;
1.11 +6 -6 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- perlstring.pmc 28 Dec 2001 18:20:12 -0000 1.10
+++ perlstring.pmc 30 Dec 2001 12:04:56 -0000 1.11
@@ -47,7 +47,7 @@
INTVAL get_integer () {
STRING* s = (STRING*) SELF->cache.struct_val;
- return string_to_int(interpreter, s);
+ return string_to_int(s);
}
INTVAL get_integer_index (INTVAL index) {
@@ -55,7 +55,7 @@
FLOATVAL get_number () {
STRING* s = (STRING*) SELF->cache.struct_val;
- return string_to_num(interpreter, s);
+ return string_to_num(s);
}
FLOATVAL get_number_index (INTVAL index) {
@@ -69,7 +69,7 @@
}
BOOLVAL get_bool () {
- return string_bool(interpreter, SELF->cache.struct_val);
+ return string_bool(SELF->cache.struct_val);
}
void* get_value () {
@@ -455,7 +455,7 @@
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
dest->cache.struct_val =
string_repeat(INTERP, SELF->cache.struct_val,
- string_to_int(interpreter, value), NULL
+ string_to_int(value), NULL
);
}
@@ -463,7 +463,7 @@
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
dest->cache.struct_val =
string_repeat(INTERP, SELF->cache.struct_val,
- string_to_int(interpreter, value), NULL
+ string_to_int(value), NULL
);
}
@@ -471,7 +471,7 @@
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
dest->cache.struct_val =
string_repeat(INTERP, SELF->cache.struct_val,
- string_to_int(interpreter, value), NULL
+ string_to_int(value), NULL
);
}
1.6 +5 -5 parrot/encodings/singlebyte.c
Index: singlebyte.c
===================================================================
RCS file: /cvs/public/parrot/encodings/singlebyte.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- singlebyte.c 6 Dec 2001 00:11:24 -0000 1.5
+++ singlebyte.c 30 Dec 2001 12:04:56 -0000 1.6
@@ -1,7 +1,7 @@
/* singlebyte.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: singlebyte.c,v 1.5 2001/12/06 00:11:24 tom Exp $
+ * $Id: singlebyte.c,v 1.6 2001/12/30 12:04:56 simon Exp $
* Overview:
* This defines the single byte encoding routines.
* Data Structure and Algorithms:
@@ -41,15 +41,15 @@
}
static void *
-singlebyte_skip_forward (void *ptr, INTVAL n) {
- byte_t *bptr = ptr;
+singlebyte_skip_forward (const void *ptr, INTVAL n) {
+ byte_t *bptr = (byte_t*)ptr;
return bptr + n;
}
static void *
-singlebyte_skip_backward (void *ptr, INTVAL n) {
- byte_t *bptr = ptr;
+singlebyte_skip_backward (const void *ptr, INTVAL n) {
+ byte_t *bptr = (byte_t*)ptr;
return bptr - n;
}
1.5 +5 -5 parrot/encodings/utf16.c
Index: utf16.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf16.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- utf16.c 6 Dec 2001 00:11:24 -0000 1.4
+++ utf16.c 30 Dec 2001 12:04:56 -0000 1.5
@@ -1,7 +1,7 @@
/* utf16.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: utf16.c,v 1.4 2001/12/06 00:11:24 tom Exp $
+ * $Id: utf16.c,v 1.5 2001/12/30 12:04:56 simon Exp $
* Overview:
* This defines the UTF-16 encoding routines.
* Data Structure and Algorithms:
@@ -77,8 +77,8 @@
}
static void *
-utf16_skip_forward (void *ptr, INTVAL n) {
- utf16_t *u16ptr = ptr;
+utf16_skip_forward (const void *ptr, INTVAL n) {
+ utf16_t *u16ptr = (utf16_t*)ptr;
while (n-- > 0) {
if (UNICODE_IS_HIGH_SURROGATE(*u16ptr)) {
@@ -100,8 +100,8 @@
}
static void *
-utf16_skip_backward (void *ptr, INTVAL n) {
- utf16_t *u16ptr = ptr;
+utf16_skip_backward (const void *ptr, INTVAL n) {
+ utf16_t *u16ptr = (utf16_t*)ptr;
while (n--> 0) {
u16ptr--;
1.2 +5 -5 parrot/encodings/utf32.c
Index: utf32.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf32.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- utf32.c 31 Oct 2001 22:51:31 -0000 1.1
+++ utf32.c 30 Dec 2001 12:04:56 -0000 1.2
@@ -1,7 +1,7 @@
/* utf32.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: utf32.c,v 1.1 2001/10/31 22:51:31 tom Exp $
+ * $Id: utf32.c,v 1.2 2001/12/30 12:04:56 simon Exp $
* Overview:
* This defines the UTF-32 encoding routines.
* Data Structure and Algorithms:
@@ -44,15 +44,15 @@
}
static void *
-utf32_skip_forward (void *ptr, INTVAL n) {
- utf32_t *u32ptr = ptr;
+utf32_skip_forward (const void *ptr, INTVAL n) {
+ utf32_t *u32ptr = (utf32_t*)ptr;
return u32ptr + n;
}
static void *
-utf32_skip_backward (void *ptr, INTVAL n) {
- utf32_t *u32ptr = ptr;
+utf32_skip_backward (const void *ptr, INTVAL n) {
+ utf32_t *u32ptr = (utf32_t*)ptr;
return u32ptr - n;
}
1.5 +5 -5 parrot/encodings/utf8.c
Index: utf8.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf8.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- utf8.c 6 Dec 2001 00:11:24 -0000 1.4
+++ utf8.c 30 Dec 2001 12:04:56 -0000 1.5
@@ -1,7 +1,7 @@
/* utf8.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: utf8.c,v 1.4 2001/12/06 00:11:24 tom Exp $
+ * $Id: utf8.c,v 1.5 2001/12/30 12:04:56 simon Exp $
* Overview:
* This defines the UTF-8 encoding routines.
* Data Structure and Algorithms:
@@ -97,8 +97,8 @@
}
static void *
-utf8_skip_forward (void *ptr, INTVAL n) {
- utf8_t *u8ptr = ptr;
+utf8_skip_forward (const void *ptr, INTVAL n) {
+ utf8_t *u8ptr = (utf8_t*)ptr;
while (n-- > 0) {
u8ptr += UTF8SKIP(u8ptr);
@@ -108,8 +108,8 @@
}
static void *
-utf8_skip_backward (void *ptr, INTVAL n) {
- utf8_t *u8ptr = ptr;
+utf8_skip_backward (const void *ptr, INTVAL n) {
+ utf8_t *u8ptr = (utf8_t*)ptr;
while (n-- > 0) {
u8ptr--;
1.5 +3 -3 parrot/include/parrot/encoding.h
Index: encoding.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/encoding.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- encoding.h 6 Dec 2001 00:11:24 -0000 1.4
+++ encoding.h 30 Dec 2001 12:04:57 -0000 1.5
@@ -1,7 +1,7 @@
/* encoding.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: encoding.h,v 1.4 2001/12/06 00:11:24 tom Exp $
+ * $Id: encoding.h,v 1.5 2001/12/30 12:04:57 simon Exp $
* Overview:
* This is the api header for the string encoding subsystem
* Data Structure and Algorithms:
@@ -19,8 +19,8 @@
INTVAL (*characters)(const void *ptr, INTVAL bytes);
INTVAL (*decode)(const void *ptr);
void *(*encode)(void *ptr, INTVAL c);
- void *(*skip_forward)(void *ptr, INTVAL n);
- void *(*skip_backward)(void *ptr, INTVAL n);
+ void *(*skip_forward)(const void *ptr, INTVAL n);
+ void *(*skip_backward)(const void *ptr, INTVAL n);
} ENCODING;
const ENCODING *
1.16 +22 -18 parrot/include/parrot/string.h
Index: string.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- string.h 28 Dec 2001 18:20:12 -0000 1.15
+++ string.h 30 Dec 2001 12:04:57 -0000 1.16
@@ -1,7 +1,7 @@
/* string.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: string.h,v 1.15 2001/12/28 18:20:12 ajgough Exp $
+ * $Id: string.h,v 1.16 2001/12/30 12:04:57 simon Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -16,7 +16,6 @@
#include "parrot/parrot.h"
typedef struct {
- void *bufstart;
INTVAL buflen;
INTVAL flags;
INTVAL bufused;
@@ -24,6 +23,7 @@
const ENCODING *encoding;
const CHARTYPE *type;
INTVAL language;
+ char bufstart[1];
} STRING;
@@ -31,42 +31,46 @@
INTVAL
string_compute_strlen(STRING*);
-INTVAL
-string_max_bytes(STRING*, INTVAL);
STRING*
-string_concat(struct Parrot_Interp *, STRING*, STRING*, INTVAL);
+string_concat(struct Parrot_Interp *interpreter, const STRING*, const STRING*,
+ INTVAL);
STRING*
-string_repeat(struct Parrot_Interp *, STRING* , INTVAL, STRING**);
+string_repeat(struct Parrot_Interp *interpreter, const STRING* , INTVAL,
+ STRING**);
STRING*
string_chopn(STRING*, INTVAL);
STRING*
-string_substr(struct Parrot_Interp *interpreter, STRING*, INTVAL, INTVAL, STRING**);
+string_substr(struct Parrot_Interp *interpreter, const STRING*, INTVAL,
+ INTVAL, STRING**);
INTVAL
-string_compare(struct Parrot_Interp *, STRING*, STRING*);
+string_compare(struct Parrot_Interp *interpreter, const STRING*, const STRING*);
BOOLVAL
-string_bool(struct Parrot_Interp *, STRING*);
+string_bool(const STRING*);
/* Declarations of other functions */
INTVAL
-string_length(STRING*);
+string_length(const STRING*);
INTVAL
-string_ord(STRING* s, INTVAL index);
+string_ord(const STRING* s, INTVAL index);
FLOATVAL
-string_to_num (struct Parrot_Interp *interpreter, STRING *s);
+string_to_num (const STRING *s);
INTVAL
-string_to_int (struct Parrot_Interp *interpreter, STRING *s);
-void
-string_grow(STRING* s, INTVAL newsize);
+string_to_int (const STRING *s);
void
string_destroy(STRING* s);
STRING*
-string_make(struct Parrot_Interp *interpreter, void *buffer, INTVAL buflen, const
ENCODING *encoding, INTVAL flags, const CHARTYPE *type);
+string_make(struct Parrot_Interp *interpreter, const void *buffer,
+ INTVAL buflen, const ENCODING *encoding, INTVAL flags,
+ const CHARTYPE *type);
STRING*
-string_copy(struct Parrot_Interp *interpreter, STRING *i);
+string_copy(struct Parrot_Interp *interpreter, const STRING *i);
STRING*
-string_transcode(struct Parrot_Interp *interpreter, STRING *src, const ENCODING
*encoding, const CHARTYPE *type, STRING *dest);
+string_transcode(struct Parrot_Interp *interpreter, const STRING *src,
+ const ENCODING *encoding, const CHARTYPE *type, STRING **d);
void
string_init(void);
+static INTVAL
+string_index(const STRING* s, INTVAL index);
#endif
1.17 +318 -112 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- string.t 28 Dec 2001 18:20:13 -0000 1.16
+++ string.t 30 Dec 2001 12:04:57 -0000 1.17
@@ -1,13 +1,16 @@
#! perl -w
-use Parrot::Test tests => 48;
+use Parrot::Test tests => 63;
-output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
+output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
set S4, "JAPH\n"
+ set S5, S4
print S4
+ print S5
end
CODE
JAPH
+JAPH
OUTPUT
output_is( <<'CODE', '4', "length_i_s" );
@@ -18,21 +21,26 @@
end
CODE
-output_is( <<'CODE', <<OUTPUT, "chopn_s_ic" );
+output_is( <<'CODE', <<OUTPUT, "chopn_s_i|ic" );
set S4, "JAPHxyzw"
set S5, "japhXYZW"
- set S3, "\n"
+ set S3, S4
+ set S1 "\n"
+ set I1 4
chopn S4, 3
chopn S4, 1
- chopn S5, 4
+ chopn S5, I1
print S4
- print S3
+ print S1
print S5
+ print S1
print S3
+ print S1
end
CODE
JAPH
japh
+JAPHxyzw
OUTPUT
output_is(<<'CODE', <<OUTPUT, "chopn, OOB values");
@@ -57,21 +65,38 @@
** nothing **
OUTPUT
-output_is( <<'CODE', 'JAPH', "substr_s_s_i_i" );
+output_is( <<'CODE', <<'OUTPUT', "substr_s_s|sc_i|ic_i|ic" );
set S4, "12345JAPH01"
set I4, 5
set I5, 4
substr S5, S4, I4, I5
print S5
+ substr S5, S4, I4, 4
+ print S5
+ substr S5, S4, 5, I5
+ print S5
+ substr S5, S4, 5, 4
+ print S5
+ substr S5, "12345JAPH01", I4, I5
+ print S5
+ substr S5, "12345JAPH01", I4, 4
+ print S5
+ substr S5, "12345JAPH01", 5, I5
+ print S5
+ substr S5, "12345JAPH01", 5, 4
+ print S5
+ print "\n"
end
CODE
+JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
+OUTPUT
# negative offsets
output_is(<<'CODE', <<'OUTPUT', "neg substr offset");
set S0, "A string of length 21"
set I0, -9
set I1, 6
- substr_s_s_i S1, S0, I0, I1
+ substr S1, S0, I0, I1
print S0
print "\n"
print S1
@@ -83,15 +108,20 @@
OUTPUT
# This asks for substring it shouldn't be allowed...
-output_is(<<'CODE', 'Cannot take substr outside string', "sub err:OOR");
+output_is(<<'CODE', 'Cannot take substr outside string', "substr OOB");
set S0, "A string of length 21"
set I0, -99
set I1, 6
- substr_s_s_i S1, S0, I0, I1
- print S0
- print "\n"
- print S1
- print "\n"
+ substr S1, S0, I0, I1
+ end
+CODE
+
+# This asks for substring it shouldn't be allowed...
+output_is(<<'CODE', 'Cannot take substr outside string', "substr OOB");
+ set S0, "A string of length 21"
+ set I0, 99
+ set I1, 6
+ substr S1, S0, I0, I1
end
CODE
@@ -100,7 +130,7 @@
set S0, "A string of length 21"
set I0, 12
set I1, 1000
- substr_s_s_i S1, S0, I0, I1
+ substr S1, S0, I0, I1
print S0
print "\n"
print S1
@@ -116,7 +146,7 @@
set S0, "A string of length 21"
set I0, -9
set I1, 1000
- substr_s_s_i S1, S0, I0, I1
+ substr S1, S0, I0, I1
print S0
print "\n"
print S1
@@ -127,42 +157,74 @@
length 21
OUTPUT
-output_is( <<'CODE', '<><', "2-param concat, null onto null" );
+output_is( <<'CODE', '<><', "concat_s_s|sc, null onto null" );
print "<>"
concat S0,S0
+ concat S1, ""
print "<"
end
CODE
-output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo1" onto null' );
+output_is( <<'CODE', <<OUTPUT, 'concat_s_s|sc, "foo1" onto null' );
concat S0,"foo1"
+ set S1, "foo2"
+ concat S2, S1
print S0
print "\n"
+ print S2
+ print "\n"
end
CODE
foo1
+foo2
OUTPUT
-output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo2" onto null' );
- set S1,"foo2"
- concat S0,S1
+output_is( <<'CODE', <<OUTPUT, "concat_s_s|sc" );
+ set S1, "fish"
+ set S2, "bone"
+ concat S1, S2
+ print S1
+ concat S1, "\n"
+ print S1
+ end
+CODE
+fishbonefishbone
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "concat_s_s|sc_s|sc" );
+ set S1, "japh"
+ set S2, "JAPH"
+ concat S0, "japh", "JAPH"
+ print S0
+ print "\n"
+ concat S0, S1, "JAPH"
+ print S0
+ print "\n"
+ concat S0, "japh", S2
+ print S0
+ print "\n"
+ concat S0, S1, S2
print S0
print "\n"
end
CODE
-foo2
+japhJAPH
+japhJAPH
+japhJAPH
+japhJAPH
OUTPUT
-output_is( <<'CODE', <<OUTPUT, "concat" );
- set S1, "fish"
- set S2, "bone"
- concat S1, S2
- print S1
- set S2, "\n"
+output_is( <<'CODE', <<OUTPUT, "concat - ensure copy is made" );
+ set S2, "JAPH"
+ concat S0, S2, ""
+ concat S1, "", S2
+ chopn S0, 1
+ chopn S1, 1
print S2
+ print "\n"
end
CODE
-fishbone
+JAPH
OUTPUT
@@ -201,7 +263,7 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "eq_s_sc_ic");
+output_is(<<CODE, <<OUTPUT, "eq_sc_s_ic");
@{[ compare_strings( 1, "eq", @strings ) ]}
print "ok\\n"
end
@@ -212,64 +274,110 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "eq_sc_s_ic");
- set S0, "I am legion"
+output_is(<<CODE, <<OUTPUT, "eq_s_sc_ic");
+@{[ compare_strings( 2, "eq", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
- eq "I am legion", S0, GOOD1
- print "not "
-GOOD1: print "ok 1\\n"
+output_is(<<CODE, <<OUTPUT, "eq_sc_sc_ic");
+@{[ compare_strings( 3, "eq", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
- eq "I am legend", S0, BAD1
- branch GOOD2
-BAD1: print "not "
-GOOD2: print "ok 2\\n"
+output_is(<<CODE, <<OUTPUT, "ne_s_s_ic");
+@{[ compare_strings( 0, "ne", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
end
CODE
-ok 1
-ok 2
+ok
OUTPUT
output_is(<<CODE, <<OUTPUT, "ne_sc_s_ic");
- set S0, "I am legion"
+@{[ compare_strings( 1, "ne", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
- ne "I am legend", S0, GOOD1
- print "not "
-GOOD1: print "ok 1\\n"
+output_is(<<CODE, <<OUTPUT, "ne_s_sc_ic");
+@{[ compare_strings( 2, "ne", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
- ne "I am legion", S0, BAD1
- branch GOOD2
-BAD1: print "not "
-GOOD2: print "ok 2\\n"
+output_is(<<CODE, <<OUTPUT, "ne_sc_sc_ic");
+@{[ compare_strings( 3, "ne", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
end
CODE
-ok 1
-ok 2
+ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "eq_sc_s");
+output_is(<<CODE, <<OUTPUT, "eq_s|sc_s|sc");
set S0, "Sparticus"
bsr TEST1
print "ok 1\\n"
bsr TEST2
print "ok 2\\n"
+ bsr TEST3
+ print "ok 3\\n"
+ bsr TEST4
+ print "ok 4\\n"
end
TEST1: eq "Sparticus", S0
print "not "
ret
-TEST2: ne "Spartisnt", S0
+TEST2: eq S0, "Sparticus"
+ print "not "
+ ret
+
+TEST3: eq S0, S0
+ print "not "
+ ret
+
+TEST4: eq "Sparticus", "Sparticus"
print "not "
ret
CODE
ok 1
ok 2
+ok 3
+ok 4
OUTPUT
-output_is(<<CODE, <<OUTPUT, "ne_s_s_ic");
-@{[ compare_strings( 0, "ne", @strings ) ]}
+output_is(<<CODE, <<OUTPUT, "lt_s_s_ic");
+@{[ compare_strings( 0, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
@@ -279,8 +387,8 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "ne_s_sc_ic");
-@{[ compare_strings( 1, "ne", @strings ) ]}
+output_is(<<CODE, <<OUTPUT, "lt_sc_s_ic");
+@{[ compare_strings( 1, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
@@ -290,8 +398,8 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "lt_s_s_ic");
-@{[ compare_strings( 0, "lt", @strings ) ]}
+output_is(<<CODE, <<OUTPUT, "lt_s_sc_ic");
+@{[ compare_strings( 2, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
@@ -301,8 +409,8 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "lt_s_sc_ic");
-@{[ compare_strings( 1, "lt", @strings ) ]}
+output_is(<<CODE, <<OUTPUT, "lt_sc_sc_ic");
+@{[ compare_strings( 3, "lt", @strings ) ]}
print "ok\\n"
end
ERROR:
@@ -323,7 +431,7 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "le_s_sc_ic");
+output_is(<<CODE, <<OUTPUT, "le_sc_s_ic");
@{[ compare_strings( 1, "le", @strings ) ]}
print "ok\\n"
end
@@ -334,6 +442,28 @@
ok
OUTPUT
+output_is(<<CODE, <<OUTPUT, "le_s_sc_ic");
+@{[ compare_strings( 2, "le", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "le_sc_sc_ic");
+@{[ compare_strings( 3, "le", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
output_is(<<CODE, <<OUTPUT, "gt_s_s_ic");
@{[ compare_strings( 0, "gt", @strings ) ]}
print "ok\\n"
@@ -345,7 +475,7 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "gt_s_sc_ic");
+output_is(<<CODE, <<OUTPUT, "gt_sc_s_ic");
@{[ compare_strings( 1, "gt", @strings ) ]}
print "ok\\n"
end
@@ -356,6 +486,28 @@
ok
OUTPUT
+output_is(<<CODE, <<OUTPUT, "gt_s_sc_ic");
+@{[ compare_strings( 2, "gt", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "gt_sc_sc_ic");
+@{[ compare_strings( 3, "gt", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
output_is(<<CODE, <<OUTPUT, "ge_s_s_ic");
@{[ compare_strings( 0, "ge", @strings ) ]}
print "ok\\n"
@@ -367,7 +519,7 @@
ok
OUTPUT
-output_is(<<CODE, <<OUTPUT, "ge_s_sc_ic");
+output_is(<<CODE, <<OUTPUT, "ge_sc_s_ic");
@{[ compare_strings( 1, "ge", @strings ) ]}
print "ok\\n"
end
@@ -378,6 +530,28 @@
ok
OUTPUT
+output_is(<<CODE, <<OUTPUT, "ge_s_sc_ic");
+@{[ compare_strings( 2, "ge", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "ge_sc_sc_ic");
+@{[ compare_strings( 3, "ge", @strings ) ]}
+ print "ok\\n"
+ end
+ERROR:
+ print "bad\\n"
+ end
+CODE
+ok
+OUTPUT
+
output_is(<<'CODE', <<OUTPUT, "same constant twice bug");
set S0, ""
set S1, ""
@@ -421,6 +595,12 @@
end
CODE
+output_is(<<'CODE',ord('a'),'2-param ord, multi-character string');
+ ord I0,"abc"
+ print I0
+ end
+CODE
+
output_is(<<'CODE',ord('a'),'2-param ord, one-character string register');
set S0,"a"
ord I0,S0
@@ -493,6 +673,13 @@
end
CODE
+output_is(<<'CODE','Cannot get character past end of string','3-param ord,
multi-character string register, from end, OOB');
+ set S0,"ab"
+ ord I0,S0,-3
+ print I0
+ end
+CODE
+
output_is(<<CODE, <<OUTPUT, "if_s_ic");
set S0, "I've told you once, I've told you twice..."
if S0, OK1
@@ -554,7 +741,7 @@
ok 9
OUTPUT
-output_is(<<CODE, <<OUTPUT, "repeat");
+output_is(<<CODE, <<OUTPUT, "repeat_s_s|sc_i|ic");
set S0, "x"
repeat S1, S0, 12
@@ -596,6 +783,12 @@
>< done
OUTPUT
+output_is(<<'CODE','Cannot repeat with negative arg','repeat OOB');
+ repeat S0, "japh", -1
+ end
+CODE
+
+
# Set all string registers to values given by &$_[0](reg num)
sub set_str_regs {
my $code = shift;
@@ -623,21 +816,34 @@
while (@strings) {
my $s1 = shift @strings;
my $s2 = shift @strings;
- my $arg;
+ my $arg1;
+ my $arg2;
+ if ($const == 3) {
+ $arg1 = "\"$s1\"";
+ $arg2 = "\"$s2\"";
+ }
+ elsif ($const == 2) {
$rt .= " set S0, \"$s1\"\n";
- if ($const) {
- $arg = "\"$s2\"";
+ $arg1 = "S0";
+ $arg2 = "\"$s2\"";
+ }
+ elsif ($const == 1) {
+ $rt .= " set S0, \"$s2\"\n";
+ $arg1 = "\"$s1\"";
+ $arg2 = "S0";
}
else {
+ $rt .= " set S0, \"$s1\"\n";
$rt .= " set S1, \"$s2\"\n";
- $arg = "S1";
+ $arg1 = "S0";
+ $arg2 = "S1";
}
if (eval "\"$s1\" $op \"$s2\"") {
- $rt .= " $op S0, $arg, OK$i\n";
+ $rt .= " $op $arg1, $arg2, OK$i\n";
$rt .= " branch ERROR\n";
}
else {
- $rt .= " $op S0, $arg, ERROR\n";
+ $rt .= " $op $arg1, $arg2, ERROR\n";
}
$rt .= "OK$i:\n";
$i++;
