-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
severity 380439 serious
tag 380439 + patch
thanks
Please find attached NMU patch for 1.37-3.1 which should fix this bug.
- --
. ''`. Luca Falavigna
: :' : Ubuntu MOTU Developer
`. `'` Debian Maintainer
`- GPG Key: 0x86BC2A50
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org
iEYEARECAAYFAkjZeb8ACgkQnXjXEYa8KlByHwCdHAHb7rgd9Yjw5rREuH0UzUCV
ytcAn3wGcprI34bjWZBE/SNrRI0zL0xo
=+hyW
-----END PGP SIGNATURE-----
diff -u tinyscheme-1.37/debian/changelog tinyscheme-1.37/debian/changelog
--- tinyscheme-1.37/debian/changelog
+++ tinyscheme-1.37/debian/changelog
@@ -1,3 +1,14 @@
+tinyscheme (1.37-3.1) unstable; urgency=medium
+
+ * Non-maintainer upload.
+ * scheme.c:
+ - Apply patch from upstream CVS (revno 1.13 and 1.21) to fix a
+ segfault when invoking let or letrec (Closes: #380439).
+ - Apply patch from upstream CVS (revno 1.7) to fail gracefully when
+ mk_vector is out of memory (Closes: #499887).
+
+ -- Luca Falavigna <[EMAIL PROTECTED]> Wed, 24 Sep 2008 01:15:22 +0200
+
tinyscheme (1.37-3) unstable; urgency=low
* took away rest of references about "ts".
only in patch2:
unchanged:
--- tinyscheme-1.37.orig/scheme.c
+++ tinyscheme-1.37/scheme.c
@@ -161,6 +161,7 @@
#define strvalue(p) ((p)->_object._string._svalue)
#define strlength(p) ((p)->_object._string._length)
+INTERFACE static int is_list(scheme *sc, pointer p);
INTERFACE INLINE int is_vector(pointer p) { return (type(p)==T_VECTOR); }
INTERFACE static void fill_vector(pointer vec, pointer obj);
INTERFACE static pointer vector_elem(pointer vec, int ielem);
@@ -926,7 +927,8 @@
}
INTERFACE static pointer mk_vector(scheme *sc, int len) {
- pointer x=get_consecutive_cells(sc,len/2+len%2+1);
+ pointer x=get_consecutive_cells(sc,len/2+len%2+1);
+ if(sc->no_memory) { return sc->sink; }
typeflag(x) = (T_VECTOR | T_ATOM);
ivalue_unchecked(x)=len;
set_integer(x);
@@ -2485,7 +2487,11 @@
case OP_LET1: /* let (calculate parameters) */
sc->args = cons(sc, sc->value, sc->args);
- if (is_pair(sc->code)) { /* continue */
+ if (is_pair(sc->code)) { /* continue */
+ if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
+ Error_1(sc, "Bad syntax of binding spec in let :",
+ car(sc->code));
+ }
s_save(sc,OP_LET1, sc->args, cdr(sc->code));
sc->code = cadar(sc->code);
sc->args = sc->NIL;
@@ -2504,8 +2510,11 @@
new_slot_in_env(sc, caar(x), car(y));
}
if (is_symbol(car(sc->code))) { /* named let */
- for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x =
cdr(x)) {
-
+ for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x =
cdr(x)) {
+ if (!is_pair(x))
+ Error_1(sc, "Bad syntax of binding in let :", x);
+ if (!is_list(sc, car(x)))
+ Error_1(sc, "Bad syntax of binding in let :", car(x));
sc->args = cons(sc, caar(x), sc->args);
}
x = mk_closure(sc, cons(sc, reverse_in_place(sc, sc->NIL,
sc->args), cddr(sc->code)), sc->envir);
@@ -2565,7 +2574,11 @@
case OP_LET1REC: /* letrec (calculate parameters) */
sc->args = cons(sc, sc->value, sc->args);
- if (is_pair(sc->code)) { /* continue */
+ if (is_pair(sc->code)) { /* continue */
+ if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
+ Error_1(sc, "Bad syntax of binding spec in letrec :",
+ car(sc->code));
+ }
s_save(sc,OP_LET1REC, sc->args, cdr(sc->code));
sc->code = cadar(sc->code);
sc->args = sc->NIL;
@@ -3119,6 +3132,7 @@
Error_1(sc,"vector: not a proper list:",sc->args);
}
vec=mk_vector(sc,len);
+ if(sc->no_memory) { s_return(sc, sc->sink); }
for (x = sc->args, i = 0; is_pair(x); x = cdr(x), i++) {
set_vector_elem(vec,i,car(x));
}
@@ -3135,7 +3149,8 @@
if(cdr(sc->args)!=sc->NIL) {
fill=cadr(sc->args);
}
- vec=mk_vector(sc,len);
+ vec=mk_vector(sc,len);
+ if(sc->no_memory) { s_return(sc, sc->sink); }
if(fill!=sc->NIL) {
fill_vector(vec,fill);
}
@@ -3179,17 +3194,64 @@
}
return sc->T;
}
+
+static int is_list(scheme *sc, pointer a) {
+ pointer slow, fast;
+
+ slow = fast = a;
+ while (1)
+ {
+ if (fast == sc->NIL)
+ return 1;
+ if (!is_pair(fast))
+ return 0;
+ fast = cdr(fast);
+ if (fast == sc->NIL)
+ return 1;
+ if (!is_pair(fast))
+ return 0;
+ fast = cdr(fast);
+
+ slow = cdr(slow);
+ if (fast == slow)
+ {
+ /* the fast pointer has looped back around and caught up
+ with the slow pointer, hence the structure is circular,
+ not of finite length, and therefore not a list */
+ return 0;
+ }
+ }
+}
static int list_length(scheme *sc, pointer a) {
- int v=0;
- pointer x;
- for (x = a, v = 0; is_pair(x); x = cdr(x)) {
- ++v;
- }
- if(x==sc->NIL) {
- return v;
- }
- return -1;
+ int i=0;
+ pointer slow, fast;
+
+ slow = fast = a;
+ while (1)
+ {
+ if (fast == sc->NIL)
+ return i;
+ if (!is_pair(fast))
+ return i;
+ fast = cdr(fast);
+ ++i;
+ if (fast == sc->NIL)
+ return i;
+ if (!is_pair(fast))
+ return i;
+ ++i;
+ fast = cdr(fast);
+
+ slow = cdr(slow);
+ if (fast == slow)
+ {
+ /* the fast pointer has looped back around and caught up
+ with the slow pointer, hence the structure is circular,
+ not of finite length, and therefore not a list */
+ return -1;
+ }
+ }
}
static pointer opexe_3(scheme *sc, enum scheme_opcodes op) {
@@ -4116,8 +4178,10 @@
is_integer,
is_real,
is_character,
- charvalue,
- is_vector,
+ charvalue,
+ is_list,
+ is_vector,
+ list_length,
ivalue,
fill_vector,
vector_elem,
