summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2014-09-19 14:47:40 +0200
committerDaniel Llorens <daniel.llorens@bluewin.ch>2014-09-30 11:35:08 +0200
commitea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e (patch)
tree028346835cd9a4bb572eb4e6b9a5d08538094fcc
parent856d318a9f543d8a61fcf61caae7d07102586802 (diff)
downloadguile-ea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e.tar.gz
Run some of arrays.test under both compiler & interpreter
* test-suite/test-suite/lib.scm (c&e): accept (pass-if exp) clause. * test-suite/tests/arrays.test: use with-prefix/c&e instead of with-prefix where possible.
-rw-r--r--test-suite/test-suite/lib.scm2
-rw-r--r--test-suite/tests/arrays.test69
2 files changed, 38 insertions, 33 deletions
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 749e8cc3a..27620a7b7 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -465,6 +465,8 @@
(define-syntax c&e
(syntax-rules (pass-if pass-if-equal pass-if-exception)
"Run the given tests both with the evaluator and the compiler/VM."
+ ((_ (pass-if exp))
+ (c&e (pass-if "[unnamed test]" exp)))
((_ (pass-if test-name exp))
(begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp))
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 415f183fe..66316fef6 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -200,7 +200,7 @@
;;; array-equal?
;;;
-(with-test-prefix "array-equal?"
+(with-test-prefix/c&e "array-equal?"
(pass-if "#s16(...)"
(array-equal? #s16(1 2 3) #s16(1 2 3))))
@@ -212,7 +212,7 @@
(define exception:mapping-out-of-range
(cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
-(with-test-prefix "make-shared-array"
+(with-test-prefix/c&e "make-shared-array"
;; this failed in guile 1.8.0
(pass-if "vector unchanged"
@@ -283,9 +283,9 @@
;;; array-contents
;;;
-(with-test-prefix "array-contents"
+(define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
- (define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
+(with-test-prefix/c&e "array-contents"
(pass-if "simple vector"
(let* ((a (make-array 0 4)))
@@ -342,30 +342,33 @@
(not (array-contents b))))
;; FIXME maybe this should be allowed.
- #;
- (pass-if "broadcast vector -> empty"
- (let* ((a (make-array 0 4))
- (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
- (if #f #f)))
+ ;; (pass-if "broadcast vector -> empty"
+ ;; (let* ((a (make-array 0 4))
+ ;; (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
+ ;; (if #f #f)))
(pass-if "broadcast 2-rank I"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list 0 j)) 2 3)))
(not (array-contents b))))
- (pass-if "broadcast 2-rank I"
+ (pass-if "broadcast 2-rank II"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list i 0)) 2 3)))
- (not (array-contents b)))))
+ (not (array-contents b))))
+
+ (pass-if "literal array"
+ (not (not (array-contents #2((1 2 3) (4 5 6)))))))
+
;;;
;;; shared-array-root
;;;
-(with-test-prefix "shared-array-root"
+(define amap1 (lambda (i) (list (* 2 i))))
+(define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
- (define amap1 (lambda (i) (list (* 2 i))))
- (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
+(with-test-prefix/c&e "shared-array-root"
(pass-if "plain vector"
(let* ((a (make-vector 4 0))
@@ -395,7 +398,7 @@
(define exception:wrong-type-arg
(cons #t "Wrong type"))
-(with-test-prefix "transpose-array"
+(with-test-prefix/c&e "transpose-array"
(pass-if-exception "non array argument" exception:wrong-type-arg
(transpose-array 99))
@@ -436,11 +439,11 @@
;;; array->list
;;;
-(with-test-prefix "array->list"
- (pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
- (pass-if-equal '(1 2 3) (array->list #(1 2 3)))
- (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
- (pass-if-equal '() (array->list #()))
+(with-test-prefix/c&e "array->list"
+ (pass-if-equal "uniform vector" '(1 2 3) (array->list #s16(1 2 3)))
+ (pass-if-equal "vector" '(1 2 3) (array->list #(1 2 3)))
+ (pass-if-equal "rank 2 array" '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
+ (pass-if-equal "empty vector" '() (array->list #()))
(pass-if-equal "http://bugs.gnu.org/12465 - ok"
'(3 4)
@@ -531,7 +534,7 @@
;;; array-in-bounds?
;;;
-(with-test-prefix "array-in-bounds?"
+(with-test-prefix/c&e "array-in-bounds?"
(pass-if (let ((a (make-array #f '(425 425))))
(eq? #f (array-in-bounds? a 0)))))
@@ -542,7 +545,7 @@
(with-test-prefix "array-type"
- (with-test-prefix "on make-foo-vector"
+ (with-test-prefix/c&e "on make-foo-vector"
(pass-if "bool"
(eq? 'b (array-type (make-bitvector 1))))
@@ -728,7 +731,7 @@
;;; syntax
;;;
-(with-test-prefix "syntax"
+(with-test-prefix/c&e "syntax"
(pass-if "rank and lower bounds"
;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
@@ -770,7 +773,7 @@
;;; equal? with vector and one-dimensional array
;;;
-(with-test-prefix "equal?"
+(with-test-prefix/c&e "equal?"
(pass-if "array and non-array"
(not (equal? #2f64((0 1) (2 3)) 100)))
@@ -805,12 +808,12 @@
;;; slices as generalized vectors
;;;
-(let ((array #2u32((0 1) (2 3))))
- (define (array-row a i)
- (make-shared-array a (lambda (j) (list i j))
- (cadr (array-dimensions a))))
- (with-test-prefix "generalized vector slices"
- (pass-if (equal? (array-row array 1)
- #u32(2 3)))
- (pass-if (equal? (array-ref (array-row array 1) 0)
- 2))))
+(define (array-row a i)
+ (make-shared-array a (lambda (j) (list i j))
+ (cadr (array-dimensions a))))
+
+(with-test-prefix/c&e "generalized vector slices"
+ (pass-if (equal? (array-row #2u32((0 1) (2 3)) 1)
+ #u32(2 3)))
+ (pass-if (equal? (array-ref (array-row #2u32((0 1) (2 3)) 1) 0)
+ 2)))