WIP: tests
This commit is contained in:
parent
b4f28d729b
commit
3fd88e2daf
|
@ -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>))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue