WIP: tests

This commit is contained in:
Jan Nieuwenhuizen 2019-11-17 15:49:28 +01:00 committed by Jan (janneke) Nieuwenhuizen
parent b4f28d729b
commit 3fd88e2daf
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
7 changed files with 20 additions and 20 deletions

View File

@ -77,10 +77,10 @@
(eq? (core:type x) <cell:port>)) (eq? (core:type x) <cell:port>))
(define (procedure? p) (define (procedure? p)
(and (or (builtin? p) (cond ((builtin? p) #t)
(and (pair? p) (eq? (car p) 'lambda)) ((and (pair? p) (eq? (car p) 'lambda)))
(closure? p)) ((closure? p) #t)
#t)) (#t #f)))
(define (special? x) (define (special? x)
(eq? (core:type x) <cell:special>)) (eq? (core:type x) <cell:special>))

View File

@ -47,6 +47,7 @@
core:write-port core:write-port
core:type core:type
%compiler %compiler
%program
equal2? equal2?
keyword->string keyword->string
pmatch-car pmatch-car
@ -93,8 +94,7 @@
(define <cell:vector> 15) (define <cell:vector> 15)
(define %arch (car (string-split %host-type #\-))) (define %arch (car (string-split %host-type #\-)))
(define %compiler "gnuc") (define %compiler "gnuc")
(define %program "the program text")
(define %compiler "gnuc")
(define keyword->string (compose symbol->string keyword->symbol)) (define keyword->string (compose symbol->string keyword->symbol))
(define (core:type x) (define (core:type x)

View File

@ -29,7 +29,6 @@
#:export ( #:export (
builtin? builtin?
mes-use-module mes-use-module
EOF
append2 append2
mes? mes?
guile? guile?
@ -37,7 +36,11 @@
guile-2? guile-2?
%arch %arch
%compiler %compiler
%program
pmatch-car
pmatch-cdr
)) ))
(cond-expand (cond-expand
(guile-2) (guile-2)
(guile (guile
@ -50,7 +53,9 @@
(define guile? #t) (define guile? #t)
(define guile-1.8? (equal? (effective-version) "1.8")) (define guile-1.8? (equal? (effective-version) "1.8"))
(define guile-2? (equal? (major-version) "2")) (define guile-2? (equal? (major-version) "2"))
(define EOF (if #f #f))
(define append2 append) (define append2 append)
(define %arch (car (string-split %host-type #\-))) (define %arch (car (string-split %host-type #\-)))
(define %compiler "gnuc") (define %compiler "gnuc")
(define %program "the program text")
(define pmatch-car car)
(define pmatch-cdr cdr)

View File

@ -22,9 +22,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
;; (define-module (tests display) (define-module (tests display)
;; #:use-module (mes mes-0) #:use-module (mes mes-0)
;; #:use-module (mes test)) #:use-module (mes test))
(mes-use-module (mes display)) (mes-use-module (mes display))
(mes-use-module (mes guile)) (mes-use-module (mes guile))

View File

@ -26,6 +26,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(define-module (tests pmatch) (define-module (tests pmatch)
#:use-module (system base pmatch) #:use-module (system base pmatch)
#:use-module (mes mes-0) #:use-module (mes mes-0)
#:use-module (mes guile)
#:use-module (mes test)) #:use-module (mes test))
(cond-expand (cond-expand

View File

@ -99,14 +99,6 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot
(pass-if-equal "assoc-set!" '((a . 0) (b . 2)) (assoc-set! '((a . 0) (b . 1)) 'b 2)) (pass-if-equal "assoc-set!" '((a . 0) (b . 2)) (assoc-set! '((a . 0) (b . 1)) 'b 2))
(pass-if-equal "assoc-set! new" '((b . 2) (a . 0)) (assoc-set! '((a . 0)) 'b 2)) (pass-if-equal "assoc-set! new" '((b . 2) (a . 0)) (assoc-set! '((a . 0)) 'b 2))
(pass-if "builtin? car" (builtin? car))
(pass-if "builtin? cdr" (builtin? cdr))
(pass-if "builtin? cons" (builtin? cons))
(pass-if "builtin? eq?" (builtin? eq?))
(pass-if "builtin? if" (builtin? eq?))
(when (not guile?)
(pass-if "builtin? eval" (not (builtin? not))))
(pass-if "procedure?" (procedure? builtin?))
(pass-if "procedure?" (procedure? procedure?)) (pass-if "procedure?" (procedure? procedure?))
(pass-if "gensym" (pass-if "gensym"
(symbol? (gensym))) (symbol? (gensym)))

View File

@ -39,7 +39,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(pass-if "vector?" (vector? #(1 2 c))) (pass-if "vector?" (vector? #(1 2 c)))
(pass-if "vector-length" (seq? (vector-length #(1)) 1)) (pass-if "vector-length" (seq? (vector-length #(1)) 1))
(pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))) (pass-if-equal "make-vector"
(list->vector (list *unspecified* *unspecified* *unspecified*))
(make-vector 3))
(pass-if "make-vector 1" (sequal? (make-vector 3 0) #(0 0 0))) (pass-if "make-vector 1" (sequal? (make-vector 3 0) #(0 0 0)))
(pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1)) (pass-if "vector-ref" (seq? (vector-ref #(0 1) 1) 1))