60 lines
2.2 KiB
Scheme
60 lines
2.2 KiB
Scheme
;;; Tests for (gulie cst)
|
|
|
|
(use-modules (srfi srfi-1)
|
|
(srfi srfi-64)
|
|
(gulie tokenizer)
|
|
(gulie cst))
|
|
|
|
(test-begin "cst")
|
|
|
|
(test-group "basic-parsing"
|
|
(let* ((tokens (tokenize "(define x 42)" "test.scm"))
|
|
(cst (parse-cst tokens)))
|
|
(test-assert "root is cst-node" (cst-node? cst))
|
|
(test-assert "root has no open paren" (not (cst-node-open cst)))
|
|
(let ((sig (cst-significant-children cst)))
|
|
(test-equal "one top-level form" 1 (length sig))
|
|
(test-assert "top-level is cst-node" (cst-node? (car sig))))))
|
|
|
|
(test-group "form-name"
|
|
(let* ((tokens (tokenize "(define x 42)" "test.scm"))
|
|
(cst (parse-cst tokens))
|
|
(form (car (cst-significant-children cst))))
|
|
(test-equal "form name is define" "define" (cst-form-name form))))
|
|
|
|
(test-group "nested-forms"
|
|
(let* ((tokens (tokenize "(let ((x 1)) (+ x 2))" "test.scm"))
|
|
(cst (parse-cst tokens))
|
|
(form (car (cst-significant-children cst))))
|
|
(test-equal "form name is let" "let" (cst-form-name form))
|
|
;; Should have nested cst-nodes for ((x 1)) and (+ x 2)
|
|
(let ((inner-nodes (filter cst-node? (cst-node-children form))))
|
|
(test-assert "has nested nodes" (>= (length inner-nodes) 2)))))
|
|
|
|
(test-group "multiple-top-level"
|
|
(let* ((tokens (tokenize "(define a 1)\n(define b 2)\n(define c 3)" "test.scm"))
|
|
(cst (parse-cst tokens))
|
|
(sig (cst-significant-children cst)))
|
|
(test-equal "three top-level forms" 3 (length sig))))
|
|
|
|
(test-group "comments-preserved"
|
|
(let* ((tokens (tokenize ";; header\n(define x 1)\n" "test.scm"))
|
|
(cst (parse-cst tokens))
|
|
(children (cst-node-children cst)))
|
|
;; Should include the comment as a token child
|
|
(test-assert "has comment token"
|
|
(any (lambda (c)
|
|
(and (token? c) (eq? (token-type c) 'line-comment)))
|
|
children))))
|
|
|
|
(test-group "prefix-handling"
|
|
(let* ((tokens (tokenize "'(1 2 3)" "test.scm"))
|
|
(cst (parse-cst tokens))
|
|
(children (cst-node-children cst)))
|
|
(test-assert "has prefix token"
|
|
(any (lambda (c)
|
|
(and (token? c) (eq? (token-type c) 'prefix)))
|
|
children))))
|
|
|
|
(test-end "cst")
|