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

check: resurrect guile-check.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-23 15:17:03 +02:00
parent ab381c841a
commit 262c507303
2 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
GNUmakefile
View File

@ -30,11 +30,14 @@ mes.h: mes.c GNUmakefile
echo "a = add_environment (a, \"$$scm_name\", &scm_$$name);" 1>&2;\ echo "a = add_environment (a, \"$$scm_name\", &scm_$$name);" 1>&2;\
done; echo '#endif'; echo '#endif' 1>&2) > $@ 2>environment.i done; echo '#endif'; echo '#endif' 1>&2) > $@ 2>environment.i
check: all check: all guile-check
./mes.test ./mes.test
./mes.test ./mes ./mes.test ./mes
cat scm.mes lib/srfi/srfi-0.scm test.mes | ./mes cat scm.mes lib/srfi/srfi-0.scm test.mes | ./mes
guile-check:
guile -s test.mes
run: all run: all
cat scm.mes test.mes | ./mes cat scm.mes test.mes | ./mes

9
test.mes
View File

@ -32,9 +32,8 @@
((car t) (display ": pass") (newline) (set! pass (+ pass 1))) ((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
(#t (display ": fail") (newline) (set! fail (+ fail 1))))))) (#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
;;(define (guile?) (defined? 'gc)) (define guile? (defined? 'gc))
(define (guile?) #f) (when guile?
(when (guile?)
(module-define! (current-module) 'builtin? (lambda (. x) #t)) (module-define! (current-module) 'builtin? (lambda (. x) #t))
(use-modules (srfi srfi-1))) (use-modules (srfi srfi-1)))
@ -167,7 +166,7 @@
;;(pass-if "builtin?" (builtin? cond)) ;;(pass-if "builtin?" (builtin? cond))
(pass-if "procedure?" (procedure? builtin?)) (pass-if "procedure?" (procedure? builtin?))
(pass-if "procedure?" (procedure? procedure?)) (pass-if "procedure?" (procedure? procedure?))
(when (not (guile?)) (when (not guile?)
(pass-if "gensym" (seq? (gensym) 'g0)) (pass-if "gensym" (seq? (gensym) 'g0))
(pass-if "gensym" (seq? (gensym) 'g1)) (pass-if "gensym" (seq? (gensym) 'g1))
(pass-if "gensym" (seq? (gensym) 'g2))) (pass-if "gensym" (seq? (gensym) 'g2)))
@ -235,7 +234,7 @@
;; (circular-list? x)) ;; (circular-list? x))
;; #t)) ;; #t))
(pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes)) 'mes)) (pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes) (guile (display ": pass: *GUILE*") 'mes)) 'mes))
(newline) (newline)
(display "passed: ") (display (car (result))) (newline) (display "passed: ") (display (car (result))) (newline)