mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Allow scm_XXX_writable_elements on empty vectors, even if immutable

Browse source 
* libguile/array-handle.c (initialize_vector_handle): Set both element
  pointers to NULL if the vector is empty.
* libguile/array-map.c (racp): Ignore immutability if destination is
  empty.
* test-suite/tests/sort.test: Check empty/mutable/immutable vectors with
  sort!.
* test-suite/tests/array-map.test: Check array-copy! with
  empty/immutable destination.
This commit is contained in:
Daniel Llorens 2017-09-15 12:36:57 +02:00
parent 1008ea3154
commit 4212f29655
4 changed files with 30 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/array-handle.c
View file

@ -149,8 +149,10 @@ initialize_vector_handle (scm_t_array_handle *h, size_t len,
h->dim0.ubnd = (ssize_t) (len - 1U); h->dim0.ubnd = (ssize_t) (len - 1U);
h->dim0.inc = 1; h->dim0.inc = 1;
h->element_type = element_type; h->element_type = element_type;
h->elements = elements; /* elements != writable_elements is used to check mutability later on.
h->writable_elements = mutable_p ? ((void *) elements) : NULL; Ignore it if the array is empty. */
h->elements = len==0 ? NULL : elements;
h->writable_elements = mutable_p ? ((void *) h->elements) : NULL;
h->vector = h->array; h->vector = h->array;
h->vref = vref; h->vref = vref;
h->vset = vset; h->vset = vset;

2
libguile/array-map.c
View file

@ -263,7 +263,7 @@ racp (SCM src, SCM dst)
{ {
SCM const * el_s = h_s.elements; SCM const * el_s = h_s.elements;
SCM * el_d = h_d.writable_elements; SCM * el_d = h_d.writable_elements;
if (!el_d) if (!el_d && n>0)
scm_wrong_type_arg_msg ("array-copy!", SCM_ARG2, dst, "mutable array"); scm_wrong_type_arg_msg ("array-copy!", SCM_ARG2, dst, "mutable array");
for (; n-- > 0; i_s += inc_s, i_d += inc_d) for (; n-- > 0; i_s += inc_s, i_d += inc_d)
el_d[i_d] = el_s[i_s]; el_d[i_d] = el_s[i_s];

4
test-suite/tests/array-map.test
View file

@ -92,6 +92,10 @@
(array-copy! #2:0:2() c) (array-copy! #2:0:2() c)
(array-equal? #2f64:0:2() c))) (array-equal? #2f64:0:2() c)))
(pass-if "empty/immutable vector"
(array-copy! #() (vector))
#t)
;; FIXME add empty, type 'b cases. ;; FIXME add empty, type 'b cases.
) )

24
test-suite/tests/sort.test
View file

@ -74,7 +74,9 @@
(let* ((a (make-typed-array 'f64 0 99 3)) (let* ((a (make-typed-array 'f64 0 99 3))
(v (make-shared-array a (lambda (i) (list (- 98 i) 0)) 99))) (v (make-shared-array a (lambda (i) (list (- 98 i) 0)) 99)))
(randomize-vector! v 99) (randomize-vector! v 99)
(sorted? (sort! v <) <))) (sorted? (sort! v <) <))))
(with-test-prefix "stable-sort!"
(pass-if "stable-sort!" (pass-if "stable-sort!"
(let ((v (randomize-vector! (make-vector 1000) 1000))) (let ((v (randomize-vector! (make-vector 1000) 1000)))
@ -92,11 +94,6 @@
(randomize-vector! v 1000) (randomize-vector! v 1000)
(sorted? (stable-sort! v <) <)))) (sorted? (stable-sort! v <) <))))
;;;
;;; stable-sort
;;;
(with-test-prefix "stable-sort" (with-test-prefix "stable-sort"
;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a ;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a
@ -108,3 +105,18 @@
;; behavior (integer underflow) leading to crashes. ;; behavior (integer underflow) leading to crashes.
(pass-if "empty vector" (pass-if "empty vector"
(equal? '#() (stable-sort '#() <)))) (equal? '#() (stable-sort '#() <))))
(with-test-prefix "mutable/immutable arguments"
(with-test-prefix/c&e "immutable arguments"
(pass-if "sort! of empty vector"
(equal? #() (sort! (vector) <)))
(pass-if "sort of immutable vector"
(equal? #(0 1) (sort #(1 0) <))))
(pass-if-exception "sort! of mutable vector (compile)"
exception:wrong-type-arg
(compile '(sort! #(0) <) #:to 'value #:env (current-module))))