[Guile-commits] 01/07: Allow scm_XXX_writable_elements on empty vectors, even if immutable

[Daniel Llorens]

lloda pushed a commit to branch stable-2.2
in repository guile.

commit 4212f29655db2e9ddca19ebd590bca5521c1b97b
Author: Daniel Llorens <address@hidden>
Date:   Fri Sep 15 12:36:57 2017 +0200

    Allow scm_XXX_writable_elements on empty vectors, even if immutable
    
    * 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.
---
 libguile/array-handle.c         |  6 ++++--
 libguile/array-map.c            |  2 +-
 test-suite/tests/array-map.test | 10 +++++++---
 test-suite/tests/sort.test      | 24 ++++++++++++++++++------
 4 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 3d81efc..947462a 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 7938396..651a1bf 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 3471841..129469d 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 249f890..fa1ffd0 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))))