From b8ff37f5ea4dd762b9b136b6848aba96189b242f Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 15:11:33 +0200
Subject: [PATCH] Don't use scm_is_generalized_vector in transpose-array

* libguile/arrays.c (scm_transpose_array)
  - Use scm_c_array_rank(), which contains an implicit is_array test.
  - Handle the rank 0 case.
* test-suite/tests/arrays.test
  - Add test for rank 0 case.
  - Add failure test for non array argument.
---
 libguile/arrays.c            | 16 ++++++++--------
 test-suite/tests/arrays.test | 13 +++++++++++++
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index ff67381ed..6188e42e5 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -477,20 +477,22 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
   SCM_VALIDATE_REST_ARGUMENT (args);
   SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
 
-  if (scm_is_generalized_vector (ra))
+  switch (scm_c_array_rank (ra))
     {
+    case 0:
+      if (!scm_is_null (args))
+	SCM_WRONG_NUM_ARGS ();
+      return ra;
+    case 1:
       /* Make sure that we are called with a single zero as
-	 arguments. 
+	 arguments.
       */
       if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
 	SCM_WRONG_NUM_ARGS ();
       SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
       SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
       return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra))
-    {
+    default:
       vargs = scm_vector (args);
       if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
 	SCM_WRONG_NUM_ARGS ();
@@ -540,8 +542,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
       scm_i_ra_set_contp (res);
       return res;
     }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
 
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index c3a28c5ec..600c29520 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -606,8 +606,21 @@
 ;;; transpose-array
 ;;;
 
+; see strings.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
 (with-test-prefix "transpose-array"
 
+  (pass-if-exception "non array argument" exception:wrong-type-arg
+    (transpose-array 99))
+
+  (pass-if "rank 0"
+    (let* ((a #0(99))
+           (b (transpose-array a)))
+      (and (array-equal? a b)
+           (eq? (shared-array-root a) (shared-array-root b)))))
+
   (pass-if "rank 1"
     (let* ((a #(1 2 3))
            (b (transpose-array a 0)))