test: hack: show expected/actual
This commit is contained in:
Jan Nieuwenhuizen
parent
3a28828bdf
commit
a7e6cb6720
139
test.mes
139
test.mes
|
|
@ -33,6 +33,31 @@
|
|||
((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
|
||||
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
|
||||
|
||||
(define (seq? a b)
|
||||
(or (eq? a b)
|
||||
(begin
|
||||
(display ": fail")
|
||||
(newline)
|
||||
(display "expected: ")
|
||||
(display b) (newline)
|
||||
(display "actual: ")
|
||||
(display a)
|
||||
(newline)
|
||||
#f)))
|
||||
|
||||
(define (sequal? a b)
|
||||
(or (equal? a b)
|
||||
(begin
|
||||
(display ": fail")
|
||||
(newline)
|
||||
(display "expected: ")
|
||||
(display b) (newline)
|
||||
(display "actual: ")
|
||||
(display a)
|
||||
(newline)
|
||||
#f)))
|
||||
|
||||
|
||||
(define-macro (pass-if name t)
|
||||
`(let ()
|
||||
(display "test: ") (display ,name)
|
||||
|
|
@ -46,18 +71,18 @@
|
|||
(pass-if "first dummy" #t)
|
||||
(pass-if-not "second dummy" #f)
|
||||
|
||||
(pass-if "and" (eq? (and 1) 1))
|
||||
(pass-if "and 2" (eq? (and 1 (= 0 1) #f) #f))
|
||||
(pass-if "or" (eq? (or) #f))
|
||||
(pass-if "or 2" (eq? (or 1) 1))
|
||||
(pass-if "or 3" (eq? (or #f (= 0 1) 3) 3))
|
||||
(pass-if "let" (eq? (let ((p 5) (q 6)) (+ p q)) 11))
|
||||
(pass-if "let loop" (equal? (let loop ((lst '(3 2 1)))
|
||||
(pass-if "and" (seq? (and 1) 1))
|
||||
(pass-if "and 2" (seq? (and 1 (= 0 1) #f) #f))
|
||||
(pass-if "or" (seq? (or) #f))
|
||||
(pass-if "or 2" (seq? (or 1) 1))
|
||||
(pass-if "or 3" (seq? (or #f (= 0 1) 3) 3))
|
||||
(pass-if "let" (seq? (let ((p 5) (q 6)) (+ p q)) 11))
|
||||
(pass-if "let loop" (sequal? (let loop ((lst '(3 2 1)))
|
||||
(if (null? lst) '()
|
||||
(cons (car lst)
|
||||
(loop (cdr lst))))) '(3 2 1)))
|
||||
(pass-if "quasiquote" (let ((cc 'bb)) (equal? `(aa bb ,cc) '(aa bb bb))))
|
||||
(pass-if "let* comments" (eq? (let* ((aa 2)
|
||||
(pass-if "quasiquote" (let ((cc 'bb)) (sequal? `(aa bb ,cc) '(aa bb bb))))
|
||||
(pass-if "let* comments" (seq? (let* ((aa 2)
|
||||
(bb (+ aa 3))
|
||||
#! boo !#
|
||||
;;(bb 4)
|
||||
|
|
@ -65,49 +90,49 @@
|
|||
bb)
|
||||
5))
|
||||
|
||||
(pass-if "map" (equal? (map identity '(1 2 3 4)) '(1 2 3 4)))
|
||||
(pass-if "map 2 " (equal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
|
||||
(pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4)))
|
||||
(pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
|
||||
'((1 . a) (2 . b) (3 . c) (4 . d))))
|
||||
(define xxxa 0)
|
||||
(pass-if "set! " (eq? (begin (set! xxxa 1) xxxa) 1))
|
||||
(pass-if "set! 2" (eq? (let ((a 0)) (set! a 1) a) 1))
|
||||
(pass-if "+" (eq? (+ 1 2 3) 6))
|
||||
(pass-if "*" (eq? (* 3 3 3) 27))
|
||||
(pass-if "/" (eq? (/ 9 3) 3))
|
||||
(pass-if "=" (= 3 '3))
|
||||
(pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1))
|
||||
(pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1))
|
||||
(pass-if "+" (seq? (+ 1 2 3) 6))
|
||||
(pass-if "*" (seq? (* 3 3 3) 27))
|
||||
(pass-if "/" (seq? (/ 9 3) 3))
|
||||
(pass-if "=" (seq? 3 '3))
|
||||
(pass-if "= 2" (not (= 3 '4)))
|
||||
(pass-if "if" (eq? (if #t 'true) 'true))
|
||||
(pass-if "if 2" (eq? (if (eq? 0 '0) 'true 'false) 'true))
|
||||
(pass-if "if 3" (eq? (if (= 1 2) 'true 'false) 'false))
|
||||
(pass-if "letrec" (= (letrec ((factorial (lambda (n)
|
||||
(pass-if "if" (seq? (if #t 'true) 'true))
|
||||
(pass-if "if 2" (seq? (if (seq? 0 '0) 'true 'false) 'true))
|
||||
(pass-if "if 3" (seq? (if (= 1 2) 'true 'false) 'false))
|
||||
(pass-if "letrec" (seq? (letrec ((factorial (lambda (n)
|
||||
(if (= n 1) 1
|
||||
(* n (factorial (- n 1)))))))
|
||||
(factorial 4))
|
||||
24))
|
||||
(pass-if "begin" (eq? (begin 'a 'b (+ 1 2)) 3))
|
||||
(pass-if "string-append" (equal? (string-append "a" "b" "c") "abc"))
|
||||
(pass-if "eq?" (not (eq? (string-append "a" "b" "c") "abc")))
|
||||
(pass-if "string-length" (= (string-length (string-append "a" "b" "c")) 3))
|
||||
(pass-if "char" (= (char->integer #\A) 65))
|
||||
(pass-if "char 2" (= (char->integer #\101) (char->integer #\A)))
|
||||
(pass-if "char 3" (eq? (integer->char 10) #\newline))
|
||||
(pass-if "char 4" (eq? (integer->char 32) #\space))
|
||||
(pass-if "string " (equal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
|
||||
(pass-if "length" (eq? (length '()) 0))
|
||||
(pass-if "length 2" (= (length '(a b c)) 3))
|
||||
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
|
||||
(pass-if "string-append" (sequal? (string-append "a" "b" "c") "abc"))
|
||||
(pass-if "eq?" (not (seq? (string-append "a" "b" "c") "abc")))
|
||||
(pass-if "string-length" (seq? (string-length (string-append "a" "b" "c")) 3))
|
||||
(pass-if "char" (seq? (char->integer #\A) 65))
|
||||
(pass-if "char 2" (seq? (char->integer #\101) (char->integer #\A)))
|
||||
(pass-if "char 3" (seq? (integer->char 10) #\newline))
|
||||
(pass-if "char 4" (seq? (integer->char 32) #\space))
|
||||
(pass-if "string " (sequal? (string #\a #\space #\s #\t #\r #\i #\n #\g) "a string"))
|
||||
(pass-if "length" (seq? (length '()) 0))
|
||||
(pass-if "length 2" (seq? (length '(a b c)) 3))
|
||||
(pass-if "vector?" (vector? #(1 2 c)))
|
||||
(pass-if "vector-length" (= (vector-length #(1)) 1))
|
||||
(pass-if "list->vector" (equal? (list->vector '(a b c)) #(a b c)))
|
||||
(pass-if "vector" (equal? #(vector 0 1 2) #(vector 0 1 2)))
|
||||
(pass-if "vector-ref" (eq? (vector-ref #(0 1) 1) 1))
|
||||
;;(pass-if "vector-set" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #(0 q)))
|
||||
;;(pass-if "vector-set" (equal? (let ((v #(0 1))) (vector-set! v 1 'q) v) #()))
|
||||
(pass-if "equal?" (equal? #(1) #(1)))
|
||||
(pass-if "equal?" (not (equal? #() #(1))))
|
||||
(pass-if "memq" (equal? (memq 'a '(a b c)) '(a b c)))
|
||||
(pass-if "memq" (equal? (memq 'b '(a b c)) '(b c)))
|
||||
(pass-if "memq" (eq? (memq 'd '(a b c)) #f))
|
||||
(pass-if "member" (equal? (member '(a) '((a) b c)) '((a) b c)))
|
||||
(pass-if "vector-length" (seq? (vector-length #(1)) 1))
|
||||
(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) #()))
|
||||
(pass-if "equal?" (sequal? #(1) #(1)))
|
||||
(pass-if "equal?" (not (sequal? #() #(1))))
|
||||
(pass-if "memq" (sequal? (memq 'a '(a b c)) '(a b c)))
|
||||
(pass-if "memq" (sequal? (memq 'b '(a b c)) '(b c)))
|
||||
(pass-if "memq" (seq? (memq 'd '(a b c)) #f))
|
||||
(pass-if "member" (sequal? (member '(a) '((a) b c)) '((a) b c)))
|
||||
|
||||
;; works, but debugging is foo
|
||||
;; (cond ((defined? 'loop2)
|
||||
|
|
@ -137,24 +162,24 @@
|
|||
(pass-if "procedure?" (procedure? builtin?))
|
||||
(pass-if "procedure?" (procedure? procedure?))
|
||||
(when (not (guile?))
|
||||
(pass-if "gensym" (eq? (gensym) 'g0))
|
||||
(pass-if "gensym" (eq? (gensym) 'g1))
|
||||
(pass-if "gensym" (eq? (gensym) 'g2)))
|
||||
(pass-if "unquote" (equal? `,(list 1 2 3 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (equal? `('boo ,@'(bah baz) 1 2) '((quote boo) bah baz 1 2)))
|
||||
(pass-if "splice" (equal? `(1 ,@(list 2 3) 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (equal? (let ((s-r '(2 3))) `(1 ,@s-r 4)) '(1 2 3 4)))
|
||||
(pass-if "unquote" (equal? `(1 2 '(,(+ 1 2))) '(1 2 '(3))))
|
||||
(pass-if "when" (eq? (when #t 'true) 'true))
|
||||
(pass-if "when 2" (eq? (when #f 'true) *unspecified*))
|
||||
(pass-if "gensym" (seq? (gensym) 'g0))
|
||||
(pass-if "gensym" (seq? (gensym) 'g1))
|
||||
(pass-if "gensym" (seq? (gensym) 'g2)))
|
||||
(pass-if "unquote" (sequal? `,(list 1 2 3 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (sequal? `('boo ,@'(bah baz) 1 2) '((quote boo) bah baz 1 2)))
|
||||
(pass-if "splice" (sequal? `(1 ,@(list 2 3) 4) '(1 2 3 4)))
|
||||
(pass-if "splice" (sequal? (let ((s-r '(2 3))) `(1 ,@s-r 4)) '(1 2 3 4)))
|
||||
(pass-if "unquote" (sequal? `(1 2 '(,(+ 1 2))) '(1 2 '(3))))
|
||||
(pass-if "when" (seq? (when #t 'true) 'true))
|
||||
(pass-if "when 2" (seq? (when #f 'true) *unspecified*))
|
||||
|
||||
(define b 0)
|
||||
(define x (lambda () b))
|
||||
(define (x) b)
|
||||
(pass-if "closure" (= (x) 0))
|
||||
(pass-if "closure" (seq? (x) 0))
|
||||
(define (c b)
|
||||
(x))
|
||||
(pass-if "closure 2" (= (c 1) 0))
|
||||
(pass-if "closure 2" (seq? (c 1) 0))
|
||||
|
||||
(define (x)
|
||||
(define b 1)
|
||||
|
|
@ -164,7 +189,7 @@
|
|||
(let ((b 2))
|
||||
(y))))
|
||||
|
||||
(pass-if "closure 3" (equal? (x) '(0 0)))
|
||||
(pass-if "closure 3" (sequal? (x) '(0 0)))
|
||||
|
||||
(newline)
|
||||
(display "passed: ") (display (car (result))) (newline)
|
||||
|
|
|
|||
Loading…
Reference in New Issue