From unknown Sat Aug 16 12:46:20 2025 X-Loop: help-debbugs@gnu.org Subject: bug#10252: bugs in array-map!, array-for-each, others Resent-From: Daniel Llorens Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-guile@gnu.org Resent-Date: Thu, 08 Dec 2011 19:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 10252 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: 10252@debbugs.gnu.org X-Debbugs-Original-To: bug-guile@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.132337244824240 (code B ref -1); Thu, 08 Dec 2011 19:28:02 +0000 Received: (at submit) by debbugs.gnu.org; 8 Dec 2011 19:27:28 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RYjct-0006Iv-Ot for submit@debbugs.gnu.org; Thu, 08 Dec 2011 14:27:28 -0500 Received: from eggs.gnu.org ([140.186.70.92]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RYiax-0004nn-1D for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:21:24 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RYia6-0001Cx-ST for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:20:32 -0500 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-3.8 required=5.0 tests=BAYES_00,RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD autolearn=unavailable version=3.3.2 Received: from lists.gnu.org ([140.186.70.17]:48683) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia6-0001Ct-Qw for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:20:30 -0500 Received: from eggs.gnu.org ([140.186.70.92]:54119) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia5-0002Yg-6O for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:30 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RYia3-0001CG-IH for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:29 -0500 Received: from zhhdzmsp-smta16.bluewin.ch ([195.186.227.132]:62613) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia3-0001C4-2d for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:27 -0500 Received: from [195.186.99.131] ([195.186.99.131:49695] helo=zhbdzmsp-smta13.bluewin.ch) by zhhdzmsp-smta16.bluewin.ch (envelope-from ) (ecelerity 2.2.3.46 r()) with ESMTP id 31/E2-28633-7EFF0EE4; Thu, 08 Dec 2011 18:20:23 +0000 Received: from [10.23.3.21] (128.179.67.121) by zhbdzmsp-smta13.bluewin.ch (8.5.142) (authenticated as dll@bluewin.ch) id 4EB3EC0001B5A7AD for bug-guile@gnu.org; Thu, 8 Dec 2011 18:20:23 +0000 From: Daniel Llorens Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: quoted-printable Date: Thu, 8 Dec 2011 19:20:21 +0100 Message-Id: Mime-Version: 1.0 (Apple Message framework v1084) X-Mailer: Apple Mail (2.1084) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.17 X-Spam-Score: -6.6 (------) X-Mailman-Approved-At: Thu, 08 Dec 2011 14:27:25 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -6.6 (------) Hello, I've found some bugs in array-map! and array-for-each. Apparently the = array parameters only get used for the required arguments. The rest get = base=3D0 and inc=3D1, which causes errors when those don't apply. 1.8.8 = works fine. I have a patch and it solves my problem, but it needs a review. I'm not = certain of understanding the functions generalized_vector_ref / set = which are used everywhere on array-map.c. Also I needed to use = array-equal? in the tests, but AFAICT equal? should work as well. The patch also changes array-for-each to work with a zero-arity = function, like for-each. I have another bug of the same sort, which I haven't looked into. The = last line gives 0 but it should give 2. ; generalized-vector-ref / set! is broken. (define (array-row a i) (make-shared-array a (lambda (j) (list i j)) (cadr (array-dimensions a)))) (define nn #2u32((0 1) (2 3))) (array-ref (array-row nn 1) 0) (generalized-vector-ref (array-row nn 1) 0) Regards, Daniel %< ----- =46rom 58e544c0034582de01f3b54f52228bfa2273578b Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Thu, 8 Dec 2011 18:49:00 +0100 Subject: [PATCH] Fix array-map! and array-for-each when rest arguments = are not compact * array-map.c (rafe, rafmap): Use array base and inc for all arguments. * array-map.c, array-map.h (array-for-each): Allow empty argument list, after for-each. * ramap.test: New tests. - array-map! with noncompact arrays and more than one argument. - array-for-each with noncompact arrays and more than two arguments. - array-for-each with zero arity function. --- libguile/array-map.c | 86 = ++++++++++++++++++++---------------------- libguile/array-map.h | 2 +- test-suite/tests/ramap.test | 79 = +++++++++++++++++++++++++++++++++++++++- 3 files changed, 120 insertions(+), 47 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index d442bdf..449318b 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -621,7 +621,6 @@ scm_ra_divide (SCM ra0, SCM ras) return 1; } =20 - int scm_array_identity (SCM dst, SCM src) { @@ -629,40 +628,36 @@ scm_array_identity (SCM dst, SCM src) } =20 =20 - static int=20 ramap (SCM ra0, SCM proc, SCM ras) { - long i =3D SCM_I_ARRAY_DIMS (ra0)->lbnd; - long inc =3D SCM_I_ARRAY_DIMS (ra0)->inc; - long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd; - long base =3D SCM_I_ARRAY_BASE (ra0) - i * inc; + long i; + long inc0 =3D SCM_I_ARRAY_DIMS (ra0)->inc; + long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd; + long base0 =3D SCM_I_ARRAY_BASE (ra0); ra0 =3D SCM_I_ARRAY_V (ra0); if (scm_is_null (ras)) - for (; i <=3D n; i++) - GVSET (ra0, i*inc+base, scm_call_0 (proc)); + for (i =3D 0; i <=3D n; i++) + GVSET (ra0, i*inc0+base0, scm_call_0 (proc)); else { - SCM ra1 =3D SCM_CAR (ras); - SCM args; - unsigned long k, i1 =3D SCM_I_ARRAY_BASE (ra1); - long inc1 =3D SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 =3D SCM_I_ARRAY_V (ra1); - ras =3D scm_vector (SCM_CDR (ras)); - =20 - for (; i <=3D n; i++, i1 +=3D inc1) + ras =3D scm_vector (ras); + for (i =3D 0; i <=3D n; i++) { - args =3D SCM_EOL; - for (k =3D scm_c_vector_length (ras); k--;) - args =3D scm_cons (GVREF (scm_c_vector_ref (ras, k), i), = args); - args =3D scm_cons (GVREF (ra1, i1), args); - GVSET (ra0, i*inc+base, scm_apply_0 (proc, args)); + SCM args =3D SCM_EOL; + unsigned long k; + for (k =3D scm_c_vector_length (ras); k--;) { + SCM rak =3D scm_c_vector_ref (ras, k); + long inck =3D SCM_I_ARRAY_DIMS (rak)->inc; + long basek =3D SCM_I_ARRAY_BASE (rak); + args =3D scm_cons (GVREF (rak, i*inck+basek), args); + } + GVSET (ra0, i*inc0+base0, scm_apply_0 (proc, args)); } } return 1; } =20 - SCM_REGISTER_PROC(s_array_map_in_order_x, "array-map-in-order!", 2, 0, = 1, scm_array_map_x); =20 SCM_SYMBOL (sym_b, "b"); @@ -690,45 +685,46 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, = 1, static int rafe (SCM ra0, SCM proc, SCM ras) { - long i =3D SCM_I_ARRAY_DIMS (ra0)->lbnd; - unsigned long i0 =3D SCM_I_ARRAY_BASE (ra0); + long i; long inc0 =3D SCM_I_ARRAY_DIMS (ra0)->inc; - long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd; + long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd; + long base0 =3D SCM_I_ARRAY_BASE (ra0); ra0 =3D SCM_I_ARRAY_V (ra0); if (scm_is_null (ras)) - for (; i <=3D n; i++, i0 +=3D inc0) - scm_call_1 (proc, GVREF (ra0, i0)); + for (i =3D 0; i <=3D n; i++) + scm_call_1 (proc, GVREF (ra0, i*inc0+base0)); else { - SCM ra1 =3D SCM_CAR (ras); - SCM args; - unsigned long k, i1 =3D SCM_I_ARRAY_BASE (ra1); - long inc1 =3D SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 =3D SCM_I_ARRAY_V (ra1); - ras =3D scm_vector (SCM_CDR (ras)); - - for (; i <=3D n; i++, i0 +=3D inc0, i1 +=3D inc1) + ras =3D scm_vector (ras); + for (i =3D 0; i <=3D n; i++) { - args =3D SCM_EOL; - for (k =3D scm_c_vector_length (ras); k--;) - args =3D scm_cons (GVREF (scm_c_vector_ref (ras, k), i), = args); - args =3D scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args); - scm_apply_0 (proc, args); + SCM args =3D SCM_EOL; + unsigned long k; + for (k =3D scm_c_vector_length (ras); k--;) { + SCM rak =3D scm_c_vector_ref (ras, k); + long inck =3D SCM_I_ARRAY_DIMS (rak)->inc; + long basek =3D SCM_I_ARRAY_BASE (rak); + args =3D scm_cons (GVREF (rak, i*inck+basek), args); + } + scm_apply_0 (proc, scm_cons (GVREF (ra0, i*inc0+base0), = args)); } } return 1; } =20 - -SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, - (SCM proc, SCM ra0, SCM lra), - "Apply @var{proc} to each tuple of elements of @var{array0} = @dots{}\n" +SCM_DEFINE (scm_array_for_each, "array-for-each", 1, 0, 1, + (SCM proc, SCM lra), + "Apply @var{proc} to each tuple of elements of @var{lra} = @dots{}\n" "in row-major order. The value returned is unspecified.") #define FUNC_NAME s_scm_array_for_each { SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_REST_ARGUMENT (lra); - scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME); +/* scm_ramapc() needs at least one argument to check shapes */ + if (!scm_is_null(lra)) + { + scm_ramapc (rafe, proc, scm_car (lra), scm_cdr (lra), FUNC_NAME); + } return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/array-map.h b/libguile/array-map.h index 43d2a92..dbb8365 100644 --- a/libguile/array-map.h +++ b/libguile/array-map.h @@ -45,7 +45,7 @@ SCM_API int scm_ra_product (SCM ra0, SCM ras); SCM_API int scm_ra_divide (SCM ra0, SCM ras); SCM_API int scm_array_identity (SCM src, SCM dst); SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra); -SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra); +SCM_API SCM scm_array_for_each (SCM proc, SCM lra); SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); SCM_INTERNAL void scm_init_array_map (void); diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test index e3a65ae..bb604e2 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/ramap.test @@ -19,6 +19,14 @@ (define-module (test-suite test-ramap) #:use-module (test-suite lib)) =20 +(define (array-row a i) + (make-shared-array a (lambda (j) (list i j)) + (cadr (array-dimensions a)))) + +(define (array-col a j) + (make-shared-array a (lambda (i) (list i j)) + (car (array-dimensions a)))) + ;;; ;;; array-index-map! ;;; @@ -183,4 +191,73 @@ (pass-if "+" (let ((a (make-array #f 4))) (array-map! a + #(1 2 3 4) #(5 6 7 8)) - (equal? a #(6 8 10 12)))))) + (equal? a #(6 8 10 12)))) + =20 + (pass-if "noncompact arrays 1" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-row a 1) (array-row a 1)) + (array-equal? c #(4 6))))) + =20 + (pass-if "noncompact arrays 2" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-col a 1)) + (array-equal? c #(2 6))))) + =20 + (pass-if "noncompact arrays 3" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-row a 1)) + (array-equal? c #(3 6))))) + =20 + (pass-if "noncompact arrays 3" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-row a 1)) + (array-equal? c #(3 6))))))) + +;;; +;;; array-for-each +;;; + +(with-test-prefix "array-for-each" + + (with-test-prefix "no sources" + (pass-if "noncompact arrays 1" + (let ((l 99)) + (array-for-each (lambda x (set! l (length x)))) + (=3D l 99)))) + + (with-test-prefix "3 sources" + (pass-if "noncompact arrays 1" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-row a 1) (array-row = a 1)) + (equal? l '((3 3 3) (2 2 2))))) + =20 + (pass-if "noncompact arrays 2" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-row a 1) (array-col = a 1)) + (equal? l '((3 3 3) (2 2 1))))) + =20 + (pass-if "noncompact arrays 3" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-col a 1) (array-col = a 1)) + (equal? l '((3 3 3) (2 1 1))))) + =20 + (pass-if "noncompact arrays 4" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-col a 1) (array-col a 0) (array-row = a 1)) + (equal? l '((3 2 3) (1 0 2))))))) --=20 1.7.1 From unknown Sat Aug 16 12:46:20 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.427 (Entity 5.427) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Daniel Llorens Subject: bug#10252: closed (Re: bug#10252: bugs in array-map!, array-for-each, others) Message-ID: References: <878vm4p7xn.fsf@pobox.com> X-Gnu-PR-Message: they-closed 10252 X-Gnu-PR-Package: guile Reply-To: 10252@debbugs.gnu.org Date: Thu, 22 Dec 2011 22:21:01 +0000 Content-Type: multipart/mixed; boundary="----------=_1324592461-18894-1" This is a multi-part message in MIME format... ------------=_1324592461-18894-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #10252: bugs in array-map!, array-for-each, others which was filed against the guile package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 10252@debbugs.gnu.org. --=20 10252: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D10252 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1324592461-18894-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 10252-done) by debbugs.gnu.org; 22 Dec 2011 22:20:14 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Rdqzl-0004ti-LR for submit@debbugs.gnu.org; Thu, 22 Dec 2011 17:20:14 -0500 Received: from a-pb-sasl-sd.pobox.com ([74.115.168.62] helo=sasl.smtp.pobox.com) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Rdqzj-0004ta-AC for 10252-done@debbugs.gnu.org; Thu, 22 Dec 2011 17:20:12 -0500 Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTP id C7D2182E8; Thu, 22 Dec 2011 17:17:58 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=sasl; bh=PyNd48igBkmJcg18STo3BRJS324=; b=RIItyd rZDfMNDSWEtRNElvBnf6y9f6/UsdqNqJQ8oIl4LZG9/ks5p/GsBDYCrUCd2uQvbc uoMmt6g3DIUxddkeciZO8+f+Nv/56oCqZvy+FdOSzKp0Ic8qbklvXWN56YYUyQWo c8LuQd5mIYiKflpPqOPJLaC9uee3b8VaT/9LQ= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; q=dns; s=sasl; b=XDBP0z0cHKewpCGCCLTukqw9qLDsvCqZ 12lgZfwVXStpeIWRo/0XkDPEUeqyRgLNRidgBsv/mCafDgjLqVkGQwSsw+0/dINX 9hNgGTjpTfAmu5zlJeEpNrCcsaJYZ9E2o1OJgcZjIoz7xjUJvLlteUpFWlO7joma uCzKvVBXcoo= Received: from a-pb-sasl-sd.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTP id C0F9882E7; Thu, 22 Dec 2011 17:17:58 -0500 (EST) Received: from badger (unknown [184.174.165.119]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-sd.pobox.com (Postfix) with ESMTPSA id 74A0A82E6; Thu, 22 Dec 2011 17:17:58 -0500 (EST) From: Andy Wingo To: Daniel Llorens Subject: Re: bug#10252: bugs in array-map!, array-for-each, others References: Date: Thu, 22 Dec 2011 17:17:56 -0500 In-Reply-To: (Daniel Llorens's message of "Thu, 8 Dec 2011 19:20:21 +0100") Message-ID: <878vm4p7xn.fsf@pobox.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Pobox-Relay-ID: CDD51AB6-2CEA-11E1-B144-65B1DE995924-02397024!a-pb-sasl-sd.pobox.com X-Spam-Score: -2.7 (--) X-Debbugs-Envelope-To: 10252-done Cc: 10252-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -2.7 (--) Hi Daniel! Very interestingly, this bug was totally backwards: they problem wasn't in array-map!, it was in generalized-vector-ref (and -set!). I fixed that bug: > ; generalized-vector-ref / set! is broken. > > (define (array-row a i) > (make-shared-array a (lambda (j) (list i j)) > (cadr (array-dimensions a)))) > (define nn #2u32((0 1) (2 3))) > > (array-ref (array-row nn 1) 0) > (generalized-vector-ref (array-row nn 1) 0) and the array stuff fixed itself. Neat, eh? I added your tests, just to make sure we don't break it in the future. I did not make the array-for-each change, as besides changing public API, it is unclear to me why we would want to allow (array-for-each proc) to work, as we don't allow (for-each proc) to work. Anyway, please submit a new patch or bug if you think it is the sensible thing to do, and we can talk about it more. Again, thanks for the patch! Andy -- http://wingolog.org/ ------------=_1324592461-18894-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 8 Dec 2011 19:27:28 +0000 Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RYjct-0006Iv-Ot for submit@debbugs.gnu.org; Thu, 08 Dec 2011 14:27:28 -0500 Received: from eggs.gnu.org ([140.186.70.92]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1RYiax-0004nn-1D for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:21:24 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RYia6-0001Cx-ST for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:20:32 -0500 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-3.8 required=5.0 tests=BAYES_00,RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD autolearn=unavailable version=3.3.2 Received: from lists.gnu.org ([140.186.70.17]:48683) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia6-0001Ct-Qw for submit@debbugs.gnu.org; Thu, 08 Dec 2011 13:20:30 -0500 Received: from eggs.gnu.org ([140.186.70.92]:54119) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia5-0002Yg-6O for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:30 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1RYia3-0001CG-IH for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:29 -0500 Received: from zhhdzmsp-smta16.bluewin.ch ([195.186.227.132]:62613) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1RYia3-0001C4-2d for bug-guile@gnu.org; Thu, 08 Dec 2011 13:20:27 -0500 Received: from [195.186.99.131] ([195.186.99.131:49695] helo=zhbdzmsp-smta13.bluewin.ch) by zhhdzmsp-smta16.bluewin.ch (envelope-from ) (ecelerity 2.2.3.46 r()) with ESMTP id 31/E2-28633-7EFF0EE4; Thu, 08 Dec 2011 18:20:23 +0000 Received: from [10.23.3.21] (128.179.67.121) by zhbdzmsp-smta13.bluewin.ch (8.5.142) (authenticated as dll@bluewin.ch) id 4EB3EC0001B5A7AD for bug-guile@gnu.org; Thu, 8 Dec 2011 18:20:23 +0000 From: Daniel Llorens Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: quoted-printable Subject: bugs in array-map!, array-for-each, others Date: Thu, 8 Dec 2011 19:20:21 +0100 Message-Id: To: bug-guile@gnu.org Mime-Version: 1.0 (Apple Message framework v1084) X-Mailer: Apple Mail (2.1084) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.17 X-Spam-Score: -6.6 (------) X-Debbugs-Envelope-To: submit X-Mailman-Approved-At: Thu, 08 Dec 2011 14:27:25 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: debbugs-submit-bounces@debbugs.gnu.org Errors-To: debbugs-submit-bounces@debbugs.gnu.org X-Spam-Score: -6.6 (------) Hello, I've found some bugs in array-map! and array-for-each. Apparently the = array parameters only get used for the required arguments. The rest get = base=3D0 and inc=3D1, which causes errors when those don't apply. 1.8.8 = works fine. I have a patch and it solves my problem, but it needs a review. I'm not = certain of understanding the functions generalized_vector_ref / set = which are used everywhere on array-map.c. Also I needed to use = array-equal? in the tests, but AFAICT equal? should work as well. The patch also changes array-for-each to work with a zero-arity = function, like for-each. I have another bug of the same sort, which I haven't looked into. The = last line gives 0 but it should give 2. ; generalized-vector-ref / set! is broken. (define (array-row a i) (make-shared-array a (lambda (j) (list i j)) (cadr (array-dimensions a)))) (define nn #2u32((0 1) (2 3))) (array-ref (array-row nn 1) 0) (generalized-vector-ref (array-row nn 1) 0) Regards, Daniel %< ----- =46rom 58e544c0034582de01f3b54f52228bfa2273578b Mon Sep 17 00:00:00 2001 From: Daniel Llorens Date: Thu, 8 Dec 2011 18:49:00 +0100 Subject: [PATCH] Fix array-map! and array-for-each when rest arguments = are not compact * array-map.c (rafe, rafmap): Use array base and inc for all arguments. * array-map.c, array-map.h (array-for-each): Allow empty argument list, after for-each. * ramap.test: New tests. - array-map! with noncompact arrays and more than one argument. - array-for-each with noncompact arrays and more than two arguments. - array-for-each with zero arity function. --- libguile/array-map.c | 86 = ++++++++++++++++++++---------------------- libguile/array-map.h | 2 +- test-suite/tests/ramap.test | 79 = +++++++++++++++++++++++++++++++++++++++- 3 files changed, 120 insertions(+), 47 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index d442bdf..449318b 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -621,7 +621,6 @@ scm_ra_divide (SCM ra0, SCM ras) return 1; } =20 - int scm_array_identity (SCM dst, SCM src) { @@ -629,40 +628,36 @@ scm_array_identity (SCM dst, SCM src) } =20 =20 - static int=20 ramap (SCM ra0, SCM proc, SCM ras) { - long i =3D SCM_I_ARRAY_DIMS (ra0)->lbnd; - long inc =3D SCM_I_ARRAY_DIMS (ra0)->inc; - long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd; - long base =3D SCM_I_ARRAY_BASE (ra0) - i * inc; + long i; + long inc0 =3D SCM_I_ARRAY_DIMS (ra0)->inc; + long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd; + long base0 =3D SCM_I_ARRAY_BASE (ra0); ra0 =3D SCM_I_ARRAY_V (ra0); if (scm_is_null (ras)) - for (; i <=3D n; i++) - GVSET (ra0, i*inc+base, scm_call_0 (proc)); + for (i =3D 0; i <=3D n; i++) + GVSET (ra0, i*inc0+base0, scm_call_0 (proc)); else { - SCM ra1 =3D SCM_CAR (ras); - SCM args; - unsigned long k, i1 =3D SCM_I_ARRAY_BASE (ra1); - long inc1 =3D SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 =3D SCM_I_ARRAY_V (ra1); - ras =3D scm_vector (SCM_CDR (ras)); - =20 - for (; i <=3D n; i++, i1 +=3D inc1) + ras =3D scm_vector (ras); + for (i =3D 0; i <=3D n; i++) { - args =3D SCM_EOL; - for (k =3D scm_c_vector_length (ras); k--;) - args =3D scm_cons (GVREF (scm_c_vector_ref (ras, k), i), = args); - args =3D scm_cons (GVREF (ra1, i1), args); - GVSET (ra0, i*inc+base, scm_apply_0 (proc, args)); + SCM args =3D SCM_EOL; + unsigned long k; + for (k =3D scm_c_vector_length (ras); k--;) { + SCM rak =3D scm_c_vector_ref (ras, k); + long inck =3D SCM_I_ARRAY_DIMS (rak)->inc; + long basek =3D SCM_I_ARRAY_BASE (rak); + args =3D scm_cons (GVREF (rak, i*inck+basek), args); + } + GVSET (ra0, i*inc0+base0, scm_apply_0 (proc, args)); } } return 1; } =20 - SCM_REGISTER_PROC(s_array_map_in_order_x, "array-map-in-order!", 2, 0, = 1, scm_array_map_x); =20 SCM_SYMBOL (sym_b, "b"); @@ -690,45 +685,46 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, = 1, static int rafe (SCM ra0, SCM proc, SCM ras) { - long i =3D SCM_I_ARRAY_DIMS (ra0)->lbnd; - unsigned long i0 =3D SCM_I_ARRAY_BASE (ra0); + long i; long inc0 =3D SCM_I_ARRAY_DIMS (ra0)->inc; - long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd; + long n =3D SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd; + long base0 =3D SCM_I_ARRAY_BASE (ra0); ra0 =3D SCM_I_ARRAY_V (ra0); if (scm_is_null (ras)) - for (; i <=3D n; i++, i0 +=3D inc0) - scm_call_1 (proc, GVREF (ra0, i0)); + for (i =3D 0; i <=3D n; i++) + scm_call_1 (proc, GVREF (ra0, i*inc0+base0)); else { - SCM ra1 =3D SCM_CAR (ras); - SCM args; - unsigned long k, i1 =3D SCM_I_ARRAY_BASE (ra1); - long inc1 =3D SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 =3D SCM_I_ARRAY_V (ra1); - ras =3D scm_vector (SCM_CDR (ras)); - - for (; i <=3D n; i++, i0 +=3D inc0, i1 +=3D inc1) + ras =3D scm_vector (ras); + for (i =3D 0; i <=3D n; i++) { - args =3D SCM_EOL; - for (k =3D scm_c_vector_length (ras); k--;) - args =3D scm_cons (GVREF (scm_c_vector_ref (ras, k), i), = args); - args =3D scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args); - scm_apply_0 (proc, args); + SCM args =3D SCM_EOL; + unsigned long k; + for (k =3D scm_c_vector_length (ras); k--;) { + SCM rak =3D scm_c_vector_ref (ras, k); + long inck =3D SCM_I_ARRAY_DIMS (rak)->inc; + long basek =3D SCM_I_ARRAY_BASE (rak); + args =3D scm_cons (GVREF (rak, i*inck+basek), args); + } + scm_apply_0 (proc, scm_cons (GVREF (ra0, i*inc0+base0), = args)); } } return 1; } =20 - -SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, - (SCM proc, SCM ra0, SCM lra), - "Apply @var{proc} to each tuple of elements of @var{array0} = @dots{}\n" +SCM_DEFINE (scm_array_for_each, "array-for-each", 1, 0, 1, + (SCM proc, SCM lra), + "Apply @var{proc} to each tuple of elements of @var{lra} = @dots{}\n" "in row-major order. The value returned is unspecified.") #define FUNC_NAME s_scm_array_for_each { SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_REST_ARGUMENT (lra); - scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME); +/* scm_ramapc() needs at least one argument to check shapes */ + if (!scm_is_null(lra)) + { + scm_ramapc (rafe, proc, scm_car (lra), scm_cdr (lra), FUNC_NAME); + } return SCM_UNSPECIFIED; } #undef FUNC_NAME diff --git a/libguile/array-map.h b/libguile/array-map.h index 43d2a92..dbb8365 100644 --- a/libguile/array-map.h +++ b/libguile/array-map.h @@ -45,7 +45,7 @@ SCM_API int scm_ra_product (SCM ra0, SCM ras); SCM_API int scm_ra_divide (SCM ra0, SCM ras); SCM_API int scm_array_identity (SCM src, SCM dst); SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra); -SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra); +SCM_API SCM scm_array_for_each (SCM proc, SCM lra); SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); SCM_INTERNAL void scm_init_array_map (void); diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test index e3a65ae..bb604e2 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/ramap.test @@ -19,6 +19,14 @@ (define-module (test-suite test-ramap) #:use-module (test-suite lib)) =20 +(define (array-row a i) + (make-shared-array a (lambda (j) (list i j)) + (cadr (array-dimensions a)))) + +(define (array-col a j) + (make-shared-array a (lambda (i) (list i j)) + (car (array-dimensions a)))) + ;;; ;;; array-index-map! ;;; @@ -183,4 +191,73 @@ (pass-if "+" (let ((a (make-array #f 4))) (array-map! a + #(1 2 3 4) #(5 6 7 8)) - (equal? a #(6 8 10 12)))))) + (equal? a #(6 8 10 12)))) + =20 + (pass-if "noncompact arrays 1" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-row a 1) (array-row a 1)) + (array-equal? c #(4 6))))) + =20 + (pass-if "noncompact arrays 2" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-col a 1)) + (array-equal? c #(2 6))))) + =20 + (pass-if "noncompact arrays 3" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-row a 1)) + (array-equal? c #(3 6))))) + =20 + (pass-if "noncompact arrays 3" + (let ((a #2((0 1) (2 3))) + (c #(0 0))) + (begin + (array-map! c + (array-col a 1) (array-row a 1)) + (array-equal? c #(3 6))))))) + +;;; +;;; array-for-each +;;; + +(with-test-prefix "array-for-each" + + (with-test-prefix "no sources" + (pass-if "noncompact arrays 1" + (let ((l 99)) + (array-for-each (lambda x (set! l (length x)))) + (=3D l 99)))) + + (with-test-prefix "3 sources" + (pass-if "noncompact arrays 1" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-row a 1) (array-row = a 1)) + (equal? l '((3 3 3) (2 2 2))))) + =20 + (pass-if "noncompact arrays 2" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-row a 1) (array-col = a 1)) + (equal? l '((3 3 3) (2 2 1))))) + =20 + (pass-if "noncompact arrays 3" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-row a 1) (array-col a 1) (array-col = a 1)) + (equal? l '((3 3 3) (2 1 1))))) + =20 + (pass-if "noncompact arrays 4" + (let* ((a #2((0 1) (2 3))) + (l '()) + (rec (lambda args (set! l (cons args l))))) + (array-for-each rec (array-col a 1) (array-col a 0) (array-row = a 1)) + (equal? l '((3 2 3) (1 0 2))))))) --=20 1.7.1 ------------=_1324592461-18894-1--