Test that typed-array? returns #f with non-array argument

[bpt/guile.git] / test-suite / tests / arrays.test

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0da1a19..eed5031 100644 (file)
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -1,6 +1,6 @@
-;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
+;;;; arrays.test --- tests guile's uniform arrays     -*- scheme -*-
 ;;;;
-;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -33,13 +33,6 @@
   (cons 'read-error ".*array length must be non-negative.*"))
 
 
-(with-test-prefix "sanity"
-  ;; At the current time of writing, bignums have a tc7 that is one bit
-  ;; away from strings. It used to be that the vector implementation
-  ;; registered for strings had the TYP7S mask, not the TYP7 mask,
-  ;; making the system think that bignums were vectors. Doh!
-  (pass-if (not (uniform-vector? 12345678901234567890123456789))))
-
 (with-test-prefix "array?"
 
   (let ((bool     (make-typed-array 'b    #t  '(5 6)))
@@ -195,7 +188,13 @@
       (pass-if (eq? #f (typed-array? float    #t)))
       (pass-if (eq? #f (typed-array? double   #t)))
       (pass-if (eq? #f (typed-array? complex  #t)))
-      (pass-if (eq? #t (typed-array? scm      #t))))))
+      (pass-if (eq? #t (typed-array? scm      #t))))
+
+    (with-test-prefix "typed-array? returns #f"
+      (pass-if (eq? #f (typed-array? '(1 2 3) 'c64)))
+      (pass-if (eq? #f (typed-array? '(1 2 3) #t)))
+      (pass-if (eq? #f (typed-array? 99 'c64)))
+      (pass-if (eq? #f (typed-array? 99 #t))))))
 
 ;;;
 ;;; array-equal?
@@ -651,39 +650,39 @@
 ;;; uniform-vector
 ;;;
 
-(with-test-prefix "uniform-vector"
+(with-test-prefix "typed arrays"
 
-  (with-test-prefix "uniform-vector-ref byte"
+  (with-test-prefix "array-ref byte"
 
     (let ((a (make-s8vector 1)))
 
       (pass-if "0"
        (begin
          (array-set! a 0 0)
-         (= 0 (uniform-vector-ref a 0))))
+         (= 0 (array-ref a 0))))
       (pass-if "127"
        (begin
          (array-set! a 127 0)
-         (= 127 (uniform-vector-ref a 0))))
+         (= 127 (array-ref a 0))))
       (pass-if "-128"
        (begin
          (array-set! a -128 0)
-         (= -128 (uniform-vector-ref a 0))))))
+         (= -128 (array-ref a 0))))))
 
-  (with-test-prefix "shared with rank 1 remain uniform vectors"
+  (with-test-prefix "shared with rank 1 equality"
 
     (let ((a #f64(1 2 3 4)))
 
       (pass-if "change offset"
         (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
-          (and (uniform-vector? b)
-               (= 3 (uniform-vector-length b))
+          (and (eq? (array-type b) (array-type a))
+               (= 3 (array-length b))
                (array-equal? b #f64(2 3 4)))))
 
       (pass-if "change stride"
         (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
-          (and (uniform-vector? c)
-               (= 2 (uniform-vector-length c))
+          (and (eq? (array-type c) (array-type a))
+               (= 2 (array-length c))
                (array-equal? c #f64(1 3))))))))
 
 ;;;