[Guile-commits] GNU Guile branch, master, updated. release_1-9-9-26-g3ffd1ba

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3ffd1ba96e986581d97079308fc15ef1fc933cdb

The branch, master has been updated
       via  3ffd1ba96e986581d97079308fc15ef1fc933cdb (commit)
      from  d26383f427245e088401f53af64b44062750925e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 3ffd1ba96e986581d97079308fc15ef1fc933cdb
Author: Andy Wingo <address@hidden>
Date:   Wed Mar 31 00:05:01 2010 +0200

    fix equal? between an array and a non-array
    
    OK let's try again. While the thanks go to Daniel Llorens del Río for
    the tip, the blame continues going to me :)
    
    * test-suite/Makefile.am:
    * test-suite/tests/arrays.test: Add a test.
    
    * libguile/array-map.c (raeql): Handle a few 0-dimensional cases. If the
      shapes of the arrays don't match, just return #f instead of raising
      an error.

-----------------------------------------------------------------------

Summary of changes:
 libguile/array-map.c                               |   22 +++++++++++++------
 test-suite/Makefile.am                             |    1 +
 .../arrays.scm => test-suite/tests/arrays.test     |   17 ++++++++-------
 3 files changed, 25 insertions(+), 15 deletions(-)
 copy module/ice-9/arrays.scm => test-suite/tests/arrays.test (73%)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 2041d05..46acb29 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -863,20 +863,29 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
   scm_t_array_dim *s0 = &dim0, *s1 = &dim1;
   unsigned long bas0 = 0, bas1 = 0;
   int k, unroll = 1, vlen = 1, ndim = 1;
+
   if (SCM_I_ARRAYP (ra0))
     {
+      if (SCM_I_ARRAY_NDIM (ra0) == 0)
+        return scm_is_true (scm_equal_p (scm_array_ref (ra0, SCM_EOL), ra1));
       ndim = SCM_I_ARRAY_NDIM (ra0);
       s0 = SCM_I_ARRAY_DIMS (ra0);
       bas0 = SCM_I_ARRAY_BASE (ra0);
       v0 = SCM_I_ARRAY_V (ra0);
     }
-  else
+  else if (scm_is_generalized_vector (v0))
     {
       s0->inc = 1;
       s0->lbnd = 0;
       s0->ubnd = scm_c_generalized_vector_length (v0) - 1;
       unroll = 0;
     }
+  else if (SCM_I_ARRAYP (ra1) && SCM_I_ARRAY_NDIM (ra1) == 0)
+    return scm_is_true (scm_equal_p (ra0, scm_array_ref (ra1, SCM_EOL)));
+  else
+    /* It's just not working out, dear. */
+    return 0;
+
   if (SCM_I_ARRAYP (ra1))
     {
       if (ndim != SCM_I_ARRAY_NDIM (ra1))
@@ -885,18 +894,17 @@ raeql (SCM ra0, SCM as_equal, SCM ra1)
       bas1 = SCM_I_ARRAY_BASE (ra1);
       v1 = SCM_I_ARRAY_V (ra1);
     }
-  else
+  else if (scm_is_generalized_vector (v1))
     {
-      /*
-       Huh ? Schizophrenic return type. --hwn
-      */
-      if (1 != ndim)
-       return 0;
       s1->inc = 1;
       s1->lbnd = 0;
       s1->ubnd = scm_c_generalized_vector_length (v1) - 1;
       unroll = 0;
     }
+  else
+    /* It's not you, it's me. */
+    return 0;
+
   if (SCM_TYP7 (v0) != SCM_TYP7 (v1))
     return 0;
   for (k = ndim; k--;)
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 36afa25..40f5a98 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -24,6 +24,7 @@ SUBDIRS = standalone
 SCM_TESTS = tests/alist.test                   \
            tests/and-let-star.test             \
            tests/arbiters.test                 \
+           tests/arrays.test                   \
            tests/asm-to-bytecode.test          \
            tests/bit-operations.test           \
            tests/brainfuck.test                \
diff --git a/module/ice-9/arrays.scm b/test-suite/tests/arrays.test
similarity index 73%
copy from module/ice-9/arrays.scm
copy to test-suite/tests/arrays.test
index f7f9e5e..30dc750 100644
--- a/module/ice-9/arrays.scm
+++ b/test-suite/tests/arrays.test
@@ -1,7 +1,7 @@
-;;; installed-scm-file
-
-;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc.
-;;;; 
+;;;; arrays.test --- tests guile's arrays     -*- scheme -*-
+;;;;
+;;;; Copyright 2010 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
@@ -15,8 +15,9 @@
 ;;;; 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
-;;;; 
 
-(define (array-shape a)
-  (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
-       (array-dimensions a)))
+(define-module (test-suite test-unif)
+  #:use-module (test-suite lib))
+
+(pass-if "equal? on array and non-array"
+  (not (equal? #2f64((0 1) (2 3)) 100)))


hooks/post-receive
-- 
GNU Guile