From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: array-set! svect value range check Date: Sat, 24 Jul 2004 09:56:52 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87zn5qgtvf.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1090627050 1290 80.91.224.253 (23 Jul 2004 23:57:30 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 23 Jul 2004 23:57:30 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Jul 24 01:57:22 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1Bo9uk-0003cg-00 for ; Sat, 24 Jul 2004 01:57:22 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1Bo9xe-0004Cq-CF for guile-devel@m.gmane.org; Fri, 23 Jul 2004 20:00:22 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1Bo9xa-0004Ca-4B for guile-devel@gnu.org; Fri, 23 Jul 2004 20:00:18 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1Bo9xZ-0004CO-Iu for guile-devel@gnu.org; Fri, 23 Jul 2004 20:00:17 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1Bo9xZ-0004CL-DN for guile-devel@gnu.org; Fri, 23 Jul 2004 20:00:17 -0400 Original-Received: from [61.8.0.84] (helo=mailout1.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.34) id 1Bo9uP-000656-Nl for guile-devel@gnu.org; Fri, 23 Jul 2004 19:57:02 -0400 Original-Received: from mailproxy1.pacific.net.au (mailproxy1.pacific.net.au [61.8.0.86]) by mailout1.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i6NNv04u014323 for ; Sat, 24 Jul 2004 09:57:00 +1000 Original-Received: from localhost (ppp2D37.dyn.pacific.net.au [61.8.45.55]) by mailproxy1.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i6NNuxvd015182 for ; Sat, 24 Jul 2004 09:56:59 +1000 Original-Received: from gg by localhost with local (Exim 3.36 #1 (Debian)) id 1Bo9uG-00030X-00; Sat, 24 Jul 2004 09:56:52 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.110003 (No Gnus v0.3) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:3882 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3882 --=-=-= 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. --=-=-= Content-Disposition: attachment; filename=unif.c.svect-set.diff --- 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: --=-=-= Content-Disposition: attachment; filename=unif.test.svect-set.diff --- 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! ;;; --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel --=-=-=--