andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

test.mes: enable vector tests for mes.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-23 07:51:19 +02:00
parent 5105f1e516
commit 119c2fef1f
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
test.mes
View File

@ -32,6 +32,10 @@
((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
(define (guile?) (defined? 'gc))
(if (guile?)
(module-define! (current-module) 'builtin? (lambda (. x) #t)))
(define (seq? a b)
(or (eq? a b)
(begin
@ -124,8 +128,9 @@
(pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
(pass-if "vector" (sequal? #(vector 0 1 2) #(vector 0 1 2)))
(pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))
;;(pass-if "vector-set" (sequal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
;;(pass-if "vector-set" (sequal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #()))
(when (not guile?) ;; hmm guile segfaults
(pass-if "vector-set" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
(pass-if "vector-set 2" (not (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #()))))
(pass-if "equal?" (sequal? #(1) #(1)))
(pass-if "equal?" (not (equal? #() #(1))))
(pass-if "memq" (sequal? (memq 'a '(a b c)) '(a b c)))
@ -156,10 +161,6 @@
;; (display ((lambda (x) x) (values 1 2 3)))
;; (newline)))
(define (guile?) (defined? 'gc))
(if (guile?)
(module-define! (current-module) 'builtin? (lambda (. x) #t)))
(pass-if "builtin?" (builtin? eval))
;;(pass-if "builtin?" (builtin? cond))
(pass-if "procedure?" (procedure? builtin?))