array-set! svect value range check

[Kevin Ryde <user42@zip.com.au>]

[-- Attachment #1: Type: text/plain, Size: 537 bytes --]

This would be for 1.6, scm_to_short has fixed it in the head.  Though
num2short in the head would get the function name into the error, like
the other ivect, uvect etc types get.

        * unif.c (scm_array_set_x): For svect, use scm_num2short to get range
        check, previously silently truncated inum to short.

Eg. on i386 where short is 16 bits,

	(define a (make-uniform-array 's 2))
	(array-set! a 65536 1)
	(array-ref a 1)
	=> 0

where I think array-set! should throw an error since 65536 is too big.
array-fill! does that.


[-- Attachment #2: unif.c.svect-set.diff --]
[-- Type: text/plain, Size: 479 bytes --]

--- unif.c.~1.146.~	2004-07-14 10:19:42.000000000 +1000
+++ unif.c	2004-07-23 14:41:01.000000000 +1000
@@ -1293,8 +1293,8 @@
 	= scm_num2long (obj, SCM_ARG2, FUNC_NAME);
       break;
     case scm_tc7_svect:
-      SCM_ASRTGO (SCM_INUMP (obj), badobj);
-      ((short *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj);
+      ((short *) SCM_UVECTOR_BASE (v))[pos]
+	= scm_num2short (obj, SCM_ARG2, FUNC_NAME);
       break;
 #if SCM_SIZEOF_LONG_LONG != 0
     case scm_tc7_llvect:

[-- Attachment #3: unif.test.svect-set.diff --]
[-- Type: text/plain, Size: 975 bytes --]

--- unif.test.~1.2.~	2004-01-25 15:19:22.000000000 +1000
+++ unif.test	2004-07-23 14:43:37.000000000 +1000
@@ -349,6 +349,36 @@
       (eq? '() (array-prototype (make-uniform-array '() '(5 6)))))))
 
 ;;;
+;;; array-set!
+;;;
+
+(with-test-prefix "array-set!"
+
+  (with-test-prefix "short"
+
+    (let ((a (make-uniform-array 's 1)))
+      ;; true if n can be array-set! into a
+      (define (fits? n)
+	(false-if-exception (begin (array-set! a n 0) #t)))
+
+      (with-test-prefix "store/fetch"
+	;; Check array-ref gives back what was put with array-set!.
+	;; Prior to Guile 1.6.5, array-set! only demanded an inum and would
+	;; silently truncate to a short.
+
+	(do ((n 1 (1+ (* 2 n))))  ;; n=2^k-1
+	    ((not (fits? n)))
+	  (array-set! a n 0)
+	  (pass-if n
+	    (= n (array-ref a 0))))
+
+	(do ((n -1 (* 2 n)))      ;; -n=2^k
+	    ((not (fits? n)))
+	  (array-set! a n 0)
+	  (pass-if n
+	    (= n (array-ref a 0))))))))
+
+;;;
 ;;; uniform-array-set1!
 ;;;
 

[-- Attachment #4: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel