Package: guile;
Reported by: Daniel Llorens <daniel.llorens <at> bluewin.ch>
Date: Thu, 8 Dec 2011 19:28:02 UTC
Severity: normal
Done: Andy Wingo <wingo <at> pobox.com>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 10252 in the body.
You can then email your comments to 10252 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-guile <at> gnu.org:bug#10252; Package guile.
(Thu, 08 Dec 2011 19:28:02 GMT) Full text and rfc822 format available.Daniel Llorens <daniel.llorens <at> bluewin.ch>:bug-guile <at> gnu.org.
(Thu, 08 Dec 2011 19:28:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Daniel Llorens <daniel.llorens <at> bluewin.ch> To: bug-guile <at> gnu.org Subject: bugs in array-map!, array-for-each, others Date: Thu, 8 Dec 2011 19:20:21 +0100
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=0 and inc=1, 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
%< -----
From 58e544c0034582de01f3b54f52228bfa2273578b Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens <at> bluewin.ch>
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;
}
-
int
scm_array_identity (SCM dst, SCM src)
{
@@ -629,40 +628,36 @@ scm_array_identity (SCM dst, SCM src)
}
-
static int
ramap (SCM ra0, SCM proc, SCM ras)
{
- long i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
- long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
- long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
- long base = SCM_I_ARRAY_BASE (ra0) - i * inc;
+ long i;
+ long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ long base0 = SCM_I_ARRAY_BASE (ra0);
ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
- for (; i <= n; i++)
- GVSET (ra0, i*inc+base, scm_call_0 (proc));
+ for (i = 0; i <= n; i++)
+ GVSET (ra0, i*inc0+base0, scm_call_0 (proc));
else
{
- SCM ra1 = SCM_CAR (ras);
- SCM args;
- unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
- long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_I_ARRAY_V (ra1);
- ras = scm_vector (SCM_CDR (ras));
-
- for (; i <= n; i++, i1 += inc1)
+ ras = scm_vector (ras);
+ for (i = 0; i <= n; i++)
{
- args = SCM_EOL;
- for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
- args = scm_cons (GVREF (ra1, i1), args);
- GVSET (ra0, i*inc+base, scm_apply_0 (proc, args));
+ SCM args = SCM_EOL;
+ unsigned long k;
+ for (k = scm_c_vector_length (ras); k--;) {
+ SCM rak = scm_c_vector_ref (ras, k);
+ long inck = SCM_I_ARRAY_DIMS (rak)->inc;
+ long basek = SCM_I_ARRAY_BASE (rak);
+ args = scm_cons (GVREF (rak, i*inck+basek), args);
+ }
+ GVSET (ra0, i*inc0+base0, scm_apply_0 (proc, args));
}
}
return 1;
}
-
SCM_REGISTER_PROC(s_array_map_in_order_x, "array-map-in-order!", 2, 0, 1, scm_array_map_x);
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 = SCM_I_ARRAY_DIMS (ra0)->lbnd;
- unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
+ long i;
long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
- long n = SCM_I_ARRAY_DIMS (ra0)->ubnd;
+ long n = SCM_I_ARRAY_DIMS (ra0)->ubnd-SCM_I_ARRAY_DIMS (ra0)->lbnd;
+ long base0 = SCM_I_ARRAY_BASE (ra0);
ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras))
- for (; i <= n; i++, i0 += inc0)
- scm_call_1 (proc, GVREF (ra0, i0));
+ for (i = 0; i <= n; i++)
+ scm_call_1 (proc, GVREF (ra0, i*inc0+base0));
else
{
- SCM ra1 = SCM_CAR (ras);
- SCM args;
- unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1);
- long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
- ra1 = SCM_I_ARRAY_V (ra1);
- ras = scm_vector (SCM_CDR (ras));
-
- for (; i <= n; i++, i0 += inc0, i1 += inc1)
+ ras = scm_vector (ras);
+ for (i = 0; i <= n; i++)
{
- args = SCM_EOL;
- for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
- args = scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args);
- scm_apply_0 (proc, args);
+ SCM args = SCM_EOL;
+ unsigned long k;
+ for (k = scm_c_vector_length (ras); k--;) {
+ SCM rak = scm_c_vector_ref (ras, k);
+ long inck = SCM_I_ARRAY_DIMS (rak)->inc;
+ long basek = SCM_I_ARRAY_BASE (rak);
+ args = scm_cons (GVREF (rak, i*inck+basek), args);
+ }
+ scm_apply_0 (proc, scm_cons (GVREF (ra0, i*inc0+base0), args));
}
}
return 1;
}
-
-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))
+(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))))
+
+ (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)))))
+
+ (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)))))
+
+ (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)))))
+
+ (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))))
+ (= 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)))))
+
+ (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)))))
+
+ (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)))))
+
+ (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)))))))
--
1.7.1
Andy Wingo <wingo <at> pobox.com>:Daniel Llorens <daniel.llorens <at> bluewin.ch>:Message #10 received at 10252-done <at> debbugs.gnu.org (full text, mbox):
From: Andy Wingo <wingo <at> pobox.com> To: Daniel Llorens <daniel.llorens <at> bluewin.ch> Cc: 10252-done <at> debbugs.gnu.org Subject: Re: bug#10252: bugs in array-map!, array-for-each, others Date: Thu, 22 Dec 2011 17:17:56 -0500
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/
Message #11 received at 10252-done <at> debbugs.gnu.org (full text, mbox):
From: Daniel Llorens <daniel.llorens <at> bluewin.ch> To: Andy Wingo <wingo <at> pobox.com> Cc: 10252-done <at> debbugs.gnu.org Subject: Re: bug#10252: bugs in array-map!, array-for-each, others Date: Fri, 23 Dec 2011 01:13:30 +0100
On Dec 22, 2011, at 23:17, Andy Wingo wrote:
> Hi Daniel!
>
> Very interestingly, this bug was totally backwards: they problem wasn't
> in array-map!, it was in generalized-vector-ref (and -set!).
Hello,
I suspected this was the case. Thanks for the review and the fix!
Just a note, the tests "noncompact arrays 3" and "… 4" are the same, the second should be
(let ((a #2((0 1) (2 3)))
(c #(0 0)))
(begin
(array-map! c + (array-row a 1) (array-col a 1))
(array-equal? c #(3 6))))
Not that these tests are complete or anything.
> 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.
Hmm, now I can't remember what made me do it. I guess that means I'm ok with things as they are.
Again, thanks for looking into this.
Regards,
Daniel
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Fri, 20 Jan 2012 12:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.