1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

fix bug in string array implementation type mask

* libguile/strings.c (SCM_ARRAY_IMPLEMENTATION): The mask for the string
  array implementation should be 0x7f, without masking out 0x2.
  Otherwise numbers were being thought to be vectors!

* test-suite/tests/unif.test: Add test.

* libguile/vectors.c (SCM_ARRAY_IMPLEMENTATION): Only register one
  implementation, because weak vectors can be checked with the mask &
  ~2, and the functions are the same.
This commit is contained in:
Andy Wingo 2009-12-29 12:35:13 +01:00
parent a1dcb961a6
commit c5f171027d
3 changed files with 10 additions and 4 deletions

View file

@ -1891,7 +1891,7 @@ string_get_handle (SCM v, scm_t_array_handle *h)
h->elements = h->writable_elements = NULL;
}
SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f & ~2,
SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f,
string_handle_ref, string_handle_set,
string_get_handle)
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)

View file

@ -625,12 +625,11 @@ vector_get_handle (SCM v, scm_t_array_handle *h)
h->elements = h->writable_elements = SCM_I_VECTOR_WELTS (v);
}
/* the & ~2 allows catching scm_tc7_wvect as well. needs changing if you change
tags.h. */
SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
vector_handle_ref, vector_handle_set,
vector_get_handle)
SCM_ARRAY_IMPLEMENTATION (scm_tc7_wvect, 0x7f & ~2,
vector_handle_ref, vector_handle_set,
vector_get_handle)
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector)

View file

@ -31,6 +31,13 @@
(cons 'read-error ".*array length must be non-negative.*"))
(with-test-prefix "sanity"
;; At the current time of writing, bignums have a tc7 that is one bit
;; away from strings. It used to be that the vector implementation
;; registered for strings had the TYP7S mask, not the TYP7 mask,
;; making the system think that bignums were vectors. Doh!
(pass-if (not (uniform-vector? 12345678901234567890123456789))))
(with-test-prefix "array?"
(let ((bool (make-typed-array 'b #t '(5 6)))