diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2014-09-19 14:47:40 +0200 |
---|---|---|
committer | Daniel Llorens <daniel.llorens@bluewin.ch> | 2014-09-30 11:35:08 +0200 |
commit | ea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e (patch) | |
tree | 028346835cd9a4bb572eb4e6b9a5d08538094fcc | |
parent | 856d318a9f543d8a61fcf61caae7d07102586802 (diff) | |
download | guile-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.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/arrays.test | 69 |
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))) |