diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 3d81efc04..947462a59 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -149,8 +149,10 @@ initialize_vector_handle (scm_t_array_handle *h, size_t len, h->dim0.ubnd = (ssize_t) (len - 1U); h->dim0.inc = 1; h->element_type = element_type; - h->elements = elements; - h->writable_elements = mutable_p ? ((void *) elements) : NULL; + /* elements != writable_elements is used to check mutability later on. + 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->vref = vref; h->vset = vset; diff --git a/libguile/array-map.c b/libguile/array-map.c index 79383969d..651a1bfb9 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -263,7 +263,7 @@ racp (SCM src, SCM dst) { SCM const * el_s = h_s.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"); for (; n-- > 0; i_s += inc_s, i_d += inc_d) el_d[i_d] = el_s[i_s]; diff --git a/test-suite/tests/array-map.test b/test-suite/tests/array-map.test index 347184112..129469d4f 100644 --- a/test-suite/tests/array-map.test +++ b/test-suite/tests/array-map.test @@ -1,17 +1,17 @@ ;;;; array-map.test --- test array mapping functions -*- scheme -*- -;;;; +;;;; ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA @@ -92,6 +92,10 @@ (array-copy! #2:0:2() c) (array-equal? #2f64:0:2() c))) + (pass-if "empty/immutable vector" + (array-copy! #() (vector)) + #t) + ;; FIXME add empty, type 'b cases. ) diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test index 249f890ec..fa1ffd0b6 100644 --- a/test-suite/tests/sort.test +++ b/test-suite/tests/sort.test @@ -74,7 +74,9 @@ (let* ((a (make-typed-array 'f64 0 99 3)) (v (make-shared-array a (lambda (i) (list (- 98 i) 0)) 99))) (randomize-vector! v 99) - (sorted? (sort! v <) <))) + (sorted? (sort! v <) <)))) + +(with-test-prefix "stable-sort!" (pass-if "stable-sort!" (let ((v (randomize-vector! (make-vector 1000) 1000))) @@ -92,11 +94,6 @@ (randomize-vector! v 1000) (sorted? (stable-sort! v <) <)))) - -;;; -;;; stable-sort -;;; - (with-test-prefix "stable-sort" ;; 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. (pass-if "empty vector" (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))))