String-ref, string-set!, vector-ref, and vector-set! index must be integer.

R5RS compliance fix. From bug #42 reported in the SourgeForge bug tracker.
This commit is contained in:
Kevin Cozens 2020-08-02 21:29:15 -04:00
parent e0b6a9cab2
commit 53b7a0935e
1 changed files with 31 additions and 9 deletions

View File

@ -3636,14 +3636,19 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
case OP_STRREF: { /* string-ref */
char *str;
pointer x;
int index;
str=strvalue(car(sc->args));
index=ivalue(cadr(sc->args));
x=cadr(sc->args);
if (!is_integer(x)) {
Error_1(sc,"string-ref: index must be exact:",x);
}
index=ivalue(x);
if(index>=g_utf8_strlen(strvalue(car(sc->args)), -1)) {
Error_1(sc,"string-ref: out of bounds:",cadr(sc->args));
Error_1(sc,"string-ref: out of bounds:",x);
}
str = g_utf8_offset_to_pointer(str, (long)index);
@ -3669,9 +3674,15 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
}
str=strvalue(a);
index=ivalue(cadr(sc->args));
if(index>=g_utf8_strlen(str, -1)) {
Error_1(sc,"string-set!: out of bounds:",cadr(sc->args));
x=cadr(sc->args);
if (!is_integer(x)) {
Error_1(sc,"string-set!: index must be exact:",x);
}
index=ivalue(x);
if(index>=strlength(car(sc->args))) {
Error_1(sc,"string-set!: out of bounds:",x);
}
c=charvalue(caddr(sc->args));
@ -3824,27 +3835,38 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
s_return(sc,mk_integer(sc,ivalue(car(sc->args))));
case OP_VECREF: { /* vector-ref */
pointer x;
int index;
index=ivalue(cadr(sc->args));
x=cadr(sc->args);
if (!is_integer(x)) {
Error_1(sc,"vector-ref: index must be exact:",x);
}
index=ivalue(x);
if(index>=ivalue(car(sc->args))) {
Error_1(sc,"vector-ref: out of bounds:",cadr(sc->args));
Error_1(sc,"vector-ref: out of bounds:",x);
}
s_return(sc,vector_elem(car(sc->args),index));
}
case OP_VECSET: { /* vector-set! */
pointer x;
int index;
if(is_immutable(car(sc->args))) {
Error_1(sc,"vector-set!: unable to alter immutable vector:",car(sc->args));
}
index=ivalue(cadr(sc->args));
x=cadr(sc->args);
if (!is_integer(x)) {
Error_1(sc,"vector-set!: index must be exact:",x);
}
index=ivalue(x);
if(index>=ivalue(car(sc->args))) {
Error_1(sc,"vector-set!: out of bounds:",cadr(sc->args));
Error_1(sc,"vector-set!: out of bounds:",x);
}
set_vector_elem(car(sc->args),index,caddr(sc->args));