move basic and semen tests to groups
This commit is contained in:
@@ -1,35 +1,31 @@
|
||||
(test-begin "basic")
|
||||
(test-group "basic"
|
||||
|
||||
;;; unkebabify
|
||||
(test '- (unkebabify '-))
|
||||
(test '-- (unkebabify '--))
|
||||
(test '-> (unkebabify '->))
|
||||
(test '-= (unkebabify '-=))
|
||||
(test 'kebab_case (unkebabify 'kebab-case))
|
||||
(test '_what_ (unkebabify '-what-))
|
||||
(test 'this->member (unkebabify 'this->member))
|
||||
(test '_this_->_member_ (unkebabify '-this-->-member-))
|
||||
(test '__->>> (unkebabify '--->>>))
|
||||
;; unkebabify
|
||||
(test '- (unkebabify '-))
|
||||
(test '-- (unkebabify '--))
|
||||
(test '-> (unkebabify '->))
|
||||
(test '-= (unkebabify '-=))
|
||||
(test 'kebab_case (unkebabify 'kebab-case))
|
||||
(test '_what_ (unkebabify '-what-))
|
||||
(test 'this->member (unkebabify 'this->member))
|
||||
(test '_this_->_member_ (unkebabify '-this-->-member-))
|
||||
(test '__->>> (unkebabify '--->>>))
|
||||
|
||||
;;; atom-to-fmt-c
|
||||
(test '%fun (atom-to-fmt-c 'fn))
|
||||
(test '%prototype (atom-to-fmt-c 'prototype))
|
||||
(test '%var (atom-to-fmt-c 'var))
|
||||
(test '%block-begin (atom-to-fmt-c 'begin))
|
||||
(test '%define (atom-to-fmt-c 'define))
|
||||
(test '%pointer (atom-to-fmt-c 'pointer))
|
||||
(test '%array (atom-to-fmt-c 'array))
|
||||
(test 'vector-ref (atom-to-fmt-c '¤))
|
||||
(test '%include (atom-to-fmt-c 'include))
|
||||
(test '%cast (atom-to-fmt-c 'cast))
|
||||
;; atom-to-fmt-c
|
||||
(test '%fun (atom-to-fmt-c 'fn))
|
||||
(test '%prototype (atom-to-fmt-c 'prototype))
|
||||
(test '%block-begin (atom-to-fmt-c 'begin))
|
||||
(test '%define (atom-to-fmt-c 'define))
|
||||
(test '%pointer (atom-to-fmt-c 'pointer))
|
||||
(test '%array (atom-to-fmt-c 'array))
|
||||
(test 'vector-ref (atom-to-fmt-c '¤))
|
||||
(test '%include (atom-to-fmt-c 'include))
|
||||
|
||||
;;; c89 stuff
|
||||
(test 'int (atom-to-fmt-c 'bool))
|
||||
(test 1 (atom-to-fmt-c 'true))
|
||||
(test 0 (atom-to-fmt-c 'false))
|
||||
;; c89 stuff
|
||||
(test 'int (atom-to-fmt-c 'bool))
|
||||
(test 1 (atom-to-fmt-c 'true))
|
||||
(test 0 (atom-to-fmt-c 'false))
|
||||
|
||||
;;; make-field-access
|
||||
(test 'a.b (make-field-access '(.b a)))
|
||||
(test 'a.b.c (make-field-access '(.c a.b)))
|
||||
|
||||
(test-end)
|
||||
;; make-field-access
|
||||
(test 'a.b (make-field-access '(.b a)))
|
||||
(test 'a.b.c (make-field-access '(.c a.b))))
|
||||
|
||||
@@ -8,51 +8,49 @@
|
||||
'(pub fn float sum ((int a) (int b))
|
||||
(return (cast float (+ a b)))))
|
||||
|
||||
(test-begin "semen")
|
||||
(test-assert (sex-fn? print-str-fn))
|
||||
(test #f (sex-fn-public? print-str-fn))
|
||||
(test 'void (sex-fn-return-type print-str-fn))
|
||||
(test 'print-str (sex-fn-name print-str-fn))
|
||||
(test '((string s)) (sex-fn-arglist print-str-fn))
|
||||
(test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn))
|
||||
(test '((printf "%s" s)) (sex-fn-body print-str-fn))
|
||||
(test-group "semen"
|
||||
(test-assert (sex-fn? print-str-fn))
|
||||
(test #f (sex-fn-public? print-str-fn))
|
||||
(test 'void (sex-fn-return-type print-str-fn))
|
||||
(test 'print-str (sex-fn-name print-str-fn))
|
||||
(test '((string s)) (sex-fn-arglist print-str-fn))
|
||||
(test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn))
|
||||
(test '((printf "%s" s)) (sex-fn-body print-str-fn))
|
||||
|
||||
(test-assert (sex-fn? sum-fn))
|
||||
(test #t (sex-fn-public? sum-fn))
|
||||
(test 'float (sex-fn-return-type sum-fn))
|
||||
(test 'sum (sex-fn-name sum-fn))
|
||||
(test '((int a) (int b)) (sex-fn-arglist sum-fn))
|
||||
(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
|
||||
(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
|
||||
(test-assert (sex-fn? sum-fn))
|
||||
(test #t (sex-fn-public? sum-fn))
|
||||
(test 'float (sex-fn-return-type sum-fn))
|
||||
(test 'sum (sex-fn-name sum-fn))
|
||||
(test '((int a) (int b)) (sex-fn-arglist sum-fn))
|
||||
(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
|
||||
(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
|
||||
|
||||
(let ((sex-code
|
||||
'((defmacro (sum-var name a b c)
|
||||
`(var ,name ,(+ a b c)))
|
||||
(let ((sex-code
|
||||
'((defmacro (sum-var name a b c)
|
||||
`(var ,name ,(+ a b c)))
|
||||
|
||||
(sum-var v 1 2 3))))
|
||||
(sum-var v 1 2 3))))
|
||||
|
||||
(test '((var v 6)) (semen-process sex-code)))
|
||||
(test '((var v 6)) (semen-process sex-code)))
|
||||
|
||||
;;; Macro expansion
|
||||
|
||||
(define (form-identity form env)
|
||||
form)
|
||||
(define (form-identity form env)
|
||||
form)
|
||||
|
||||
(test 'a (semen-walk-form 'a form-identity (make-hash-table)))
|
||||
(test '(a b c) (semen-walk-form '(a b c) form-identity (make-hash-table)))
|
||||
(test 'a (semen-walk-form 'a form-identity (make-hash-table)))
|
||||
(test '(a b c) (semen-walk-form '(a b c) form-identity (make-hash-table)))
|
||||
|
||||
(test 'a (semen-macro-expand 'a))
|
||||
(test '(a b c) (semen-macro-expand '(a b c)))
|
||||
(test 'a (semen-macro-expand 'a))
|
||||
(test '(a b c) (semen-macro-expand '(a b c)))
|
||||
|
||||
(let ((sex-code-macro
|
||||
'((defmacro (x10 a)
|
||||
`(* 10 ,a))
|
||||
(let ((sex-code-macro
|
||||
'((defmacro (x10 a)
|
||||
`(* 10 ,a))
|
||||
|
||||
(fn void foo ((int a) (int b))
|
||||
(return (+ a (x10 b)))))))
|
||||
(fn void foo ((int a) (int b))
|
||||
(return (+ a (x10 b)))))))
|
||||
|
||||
(test '((fn void foo ((int a) (int b))
|
||||
(return (+ a (* 10 b)))))
|
||||
(semen-process sex-code-macro)))
|
||||
|
||||
(test-end)
|
||||
(test '((fn void foo ((int a) (int b))
|
||||
(return (+ a (* 10 b)))))
|
||||
(semen-process sex-code-macro))))
|
||||
|
||||
Reference in New Issue
Block a user