Pavel Kulyov
78862cfe4f
All checks were successful
Sex CI / build-linux (pull_request) Successful in 4m45s
118 lines
3.5 KiB
Scheme
118 lines
3.5 KiB
Scheme
(import srfi-69
|
|
semen
|
|
types)
|
|
|
|
(define print-str-fn
|
|
'(fn print-str ((s string)) void
|
|
(printf "%s" s)))
|
|
|
|
(define sum-fn
|
|
'(pub fn sum ((a int) (b int)) float
|
|
(return (cast (+ a b) float))))
|
|
|
|
(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 '((s string)) (sex-fn-arglist print-str-fn))
|
|
(test '(fn print-str ((s string)) void) (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 '((a int) (b int)) (sex-fn-arglist sum-fn))
|
|
(test '(pub fn sum ((a int) (b int)) float) (sex-fn-prototype sum-fn))
|
|
(test '((return (cast (+ a b) float))) (sex-fn-body sum-fn))
|
|
|
|
(test-assert (sex-fn? '(extern fn foo () void)))
|
|
(test 'foo (sex-fn-name '(extern fn foo () void)))
|
|
(test #f (sex-fn? '(struct point ((x int)))))
|
|
|
|
(let ((sex-code
|
|
'((defmacro (sum-var name a b c)
|
|
`(var ,name ,(+ a b c)))
|
|
|
|
(sum-var v 1 2 3))))
|
|
|
|
(test '((var v 6)) (semen-process sex-code)))
|
|
|
|
;;; Macro expansion
|
|
|
|
(define (form-identity form env)
|
|
form)
|
|
|
|
(test 'a (walk-form 'a form-identity (make-hash-table)))
|
|
(test '(a b c) (walk-form '(a b c) form-identity (make-hash-table)))
|
|
|
|
(test 'a (macro-expand 'a))
|
|
(test '(a b c) (macro-expand '(a b c)))
|
|
|
|
(let ((sex-code-macro
|
|
'((defmacro (x10 a)
|
|
`(* 10 ,a))
|
|
|
|
(fn foo ((a int) (b int)) void
|
|
(return (+ a (x10 b)))))))
|
|
|
|
(test '((fn foo ((a int) (b int)) void
|
|
(return (+ a (* 10 b)))))
|
|
(semen-process sex-code-macro)))
|
|
|
|
;;; Docstrings are lifted out as comment forms sitting before the
|
|
;;; declaration. A string later in a body is left alone.
|
|
|
|
(test '((comment "Greet NAME.")
|
|
(fn greet ((name (* char))) void
|
|
(printf "Hello %s!\n" name)))
|
|
(semen-process
|
|
'((fn greet ((name (* char))) void
|
|
"Greet NAME."
|
|
(printf "Hello %s!\n" name)))))
|
|
|
|
(test '((comment "Public entry.")
|
|
(pub fn main () int
|
|
(return 0)))
|
|
(semen-process
|
|
'((pub fn main () int
|
|
"Public entry."
|
|
(return 0)))))
|
|
|
|
;; A prototype whose only "body" is a docstring stays a prototype
|
|
(test '((comment "Forward.")
|
|
(fn helper ((a int)) int))
|
|
(semen-process
|
|
'((fn helper ((a int)) int
|
|
"Forward."))))
|
|
|
|
(test '((fn f () void (g) "not a docstring"))
|
|
(semen-process
|
|
'((fn f () void (g) "not a docstring"))))
|
|
|
|
;; `;' comments before the string are skipped when looking for it,
|
|
;; and stay in the body
|
|
(test '((comment "Kept.")
|
|
(fn f () void (comment " note") (g)))
|
|
(semen-process
|
|
'((fn f () void (comment " note") "Kept." (g)))))
|
|
|
|
(test '((comment "A 2D point.")
|
|
(struct t-doc-pt ((x int) (y int))))
|
|
(semen-process
|
|
'((struct t-doc-pt "A 2D point." ((x int) (y int))))))
|
|
|
|
(test '((x int) (y int))
|
|
(get-fields 't-doc-pt))
|
|
|
|
(test '((comment "RGB.")
|
|
(enum t-doc-color (red green blue)))
|
|
(semen-process
|
|
'((enum t-doc-color "RGB." (red green blue)))))
|
|
|
|
(test '((comment "Either.")
|
|
(union t-doc-val ((i int) (f float))))
|
|
(semen-process
|
|
'((union t-doc-val "Either." ((i int) (f float))))))
|
|
) |