mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity

Run some of arrays.test under both compiler & interpreter

Browse source 
* 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.
This commit is contained in:
Daniel Llorens 2014-09-19 14:47:40 +02:00
parent 856d318a9f
commit ea342aa6f7
2 changed files with 38 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

2
test-suite/test-suite/lib.scm
View file

@ -465,6 +465,8 @@
(define-syntax c&e (define-syntax c&e
(syntax-rules (pass-if pass-if-equal pass-if-exception) (syntax-rules (pass-if pass-if-equal pass-if-exception)
"Run the given tests both with the evaluator and the compiler/VM." "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)) ((_ (pass-if test-name exp))
(begin (pass-if (string-append test-name " (eval)") (begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp)) (primitive-eval 'exp))

69
test-suite/tests/arrays.test
View file

@ -200,7 +200,7 @@
;;; array-equal? ;;; array-equal?
;;; ;;;
(with-test-prefix "array-equal?" (with-test-prefix/c&e "array-equal?"
(pass-if "#s16(...)" (pass-if "#s16(...)"
(array-equal? #s16(1 2 3) #s16(1 2 3)))) (array-equal? #s16(1 2 3) #s16(1 2 3))))
@ -212,7 +212,7 @@
(define exception:mapping-out-of-range (define exception:mapping-out-of-range
(cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array (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 ;; this failed in guile 1.8.0
(pass-if "vector unchanged" (pass-if "vector unchanged"
@ -283,9 +283,9 @@
;;; array-contents ;;; 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" (pass-if "simple vector"
(let* ((a (make-array 0 4))) (let* ((a (make-array 0 4)))
@ -342,30 +342,33 @@
(not (array-contents b)))) (not (array-contents b))))
;; FIXME maybe this should be allowed. ;; FIXME maybe this should be allowed.
#; ;; (pass-if "broadcast vector -> empty"
(pass-if "broadcast vector -> empty" ;; (let* ((a (make-array 0 4))
(let* ((a (make-array 0 4)) ;; (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
(b (make-shared-array a (lambda (i j k) (list k)) 0 1 4))) ;; (if #f #f)))
(if #f #f)))
(pass-if "broadcast 2-rank I" (pass-if "broadcast 2-rank I"
(let* ((a #2((1 2 3) (4 5 6))) (let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list 0 j)) 2 3))) (b (make-shared-array a (lambda (i j) (list 0 j)) 2 3)))
(not (array-contents b)))) (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))) (let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list i 0)) 2 3))) (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 ;;; 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)))) (with-test-prefix/c&e "shared-array-root"
(define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
(pass-if "plain vector" (pass-if "plain vector"
(let* ((a (make-vector 4 0)) (let* ((a (make-vector 4 0))
@ -395,7 +398,7 @@
(define exception:wrong-type-arg (define exception:wrong-type-arg
(cons #t "Wrong type")) (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 (pass-if-exception "non array argument" exception:wrong-type-arg
(transpose-array 99)) (transpose-array 99))
@ -436,11 +439,11 @@
;;; array->list ;;; array->list
;;; ;;;
(with-test-prefix "array->list" (with-test-prefix/c&e "array->list"
(pass-if-equal '(1 2 3) (array->list #s16(1 2 3))) (pass-if-equal "uniform vector" '(1 2 3) (array->list #s16(1 2 3)))
(pass-if-equal '(1 2 3) (array->list #(1 2 3))) (pass-if-equal "vector" '(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 "rank 2 array" '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
(pass-if-equal '() (array->list #())) (pass-if-equal "empty vector" '() (array->list #()))
(pass-if-equal "http://bugs.gnu.org/12465 - ok" (pass-if-equal "http://bugs.gnu.org/12465 - ok"
'(3 4) '(3 4)
@ -531,7 +534,7 @@
;;; array-in-bounds? ;;; 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)))) (pass-if (let ((a (make-array #f '(425 425))))
(eq? #f (array-in-bounds? a 0))))) (eq? #f (array-in-bounds? a 0)))))
@ -542,7 +545,7 @@
(with-test-prefix "array-type" (with-test-prefix "array-type"
(with-test-prefix "on make-foo-vector" (with-test-prefix/c&e "on make-foo-vector"
(pass-if "bool" (pass-if "bool"
(eq? 'b (array-type (make-bitvector 1)))) (eq? 'b (array-type (make-bitvector 1))))
@ -728,7 +731,7 @@
;;; syntax ;;; syntax
;;; ;;;
(with-test-prefix "syntax" (with-test-prefix/c&e "syntax"
(pass-if "rank and lower bounds" (pass-if "rank and lower bounds"
;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8. ;; 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 ;;; equal? with vector and one-dimensional array
;;; ;;;
(with-test-prefix "equal?" (with-test-prefix/c&e "equal?"
(pass-if "array and non-array" (pass-if "array and non-array"
(not (equal? #2f64((0 1) (2 3)) 100))) (not (equal? #2f64((0 1) (2 3)) 100)))
@ -805,12 +808,12 @@
;;; slices as generalized vectors ;;; slices as generalized vectors
;;; ;;;
(let ((array #2u32((0 1) (2 3)))) (define (array-row a i)
(define (array-row a i) (make-shared-array a (lambda (j) (list i j))
(make-shared-array a (lambda (j) (list i j)) (cadr (array-dimensions a))))
(cadr (array-dimensions a))))
(with-test-prefix "generalized vector slices" (with-test-prefix/c&e "generalized vector slices"
(pass-if (equal? (array-row array 1) (pass-if (equal? (array-row #2u32((0 1) (2 3)) 1)
#u32(2 3))) #u32(2 3)))
(pass-if (equal? (array-ref (array-row array 1) 0) (pass-if (equal? (array-ref (array-row #2u32((0 1) (2 3)) 1) 0)
2)))) 2)))