summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/arrays.c16
-rw-r--r--test-suite/tests/arrays.test13
2 files changed, 21 insertions, 8 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 0d39e8eae..a8b62b2b0 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)))