mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

Use test submodules for yaragg lang tests

Browse Source
remotes/jackfirth/master
Jack Firth 3 years ago
parent 5a90bb6551
commit e7415fc690
27 changed files with 1015 additions and 968 deletions
Show Stats Download Patch File Download Diff File

51
tests/test-01-equal.rkt
Unescape Escape View File

@ -1,30 +1,31 @@
#lang racket/base #lang racket/base
(require yaragg/examples/01-equal (module+ test
rackunit)
(check-equal? (syntax->datum (parse "")) (require yaragg/examples/01-equal
'(equal)) rackunit)
(check-equal? (syntax->datum (parse "01"))
'(equal (zero (equal) "0")
(one (equal) "1")))
(check-equal? (syntax->datum (parse "10"))
'(equal (one (equal) "1")
(zero (equal) "0")))
(check-equal? (syntax->datum (parse "0011"))
'(equal (zero (equal) "0")
(one (equal (zero (equal) "0")
(one (equal) "1"))
"1")))
(check-equal? (syntax->datum (parse "0110"))
'(equal (one (equal (zero (equal) "0")
(one (equal) "1"))
"1")
(zero (equal) "0")))
(check-equal? (syntax->datum (parse "1100")) (check-equal? (syntax->datum (parse ""))
'(equal (one (equal) "1") '(equal))
(zero (equal (one (equal) "1") (check-equal? (syntax->datum (parse "01"))
(zero (equal) "0")) '(equal (zero (equal) "0")
"0"))) (one (equal) "1")))
(check-equal? (syntax->datum (parse "10"))
'(equal (one (equal) "1")
(zero (equal) "0")))
(check-equal? (syntax->datum (parse "0011"))
'(equal (zero (equal) "0")
(one (equal (zero (equal) "0")
(one (equal) "1"))
"1")))
(check-equal? (syntax->datum (parse "0110"))
'(equal (one (equal (zero (equal) "0")
(one (equal) "1"))
"1")
(zero (equal) "0")))
(check-equal? (syntax->datum (parse "1100"))
'(equal (one (equal) "1")
(zero (equal (one (equal) "1")
(zero (equal) "0"))
"0"))))

72
tests/test-0n1.rkt
Unescape Escape View File

@ -1,50 +1,52 @@
#lang racket/base #lang racket/base
(require yaragg/examples/0n1 (module+ test
yaragg/support
rackunit)
(define (lex ip) (require yaragg/examples/0n1
(port-count-lines! ip) yaragg/support
(lambda () rackunit)
(define next-char (read-char ip))
(cond [(eof-object? next-char)
(token eof)]
[(char=? next-char #\0)
(token "0" "0")]
[(char=? next-char #\1)
(token "1" "1")])))
(define (lex ip)
(port-count-lines! ip)
(lambda ()
(define next-char (read-char ip))
(cond [(eof-object? next-char)
(token eof)]
[(char=? next-char #\0)
(token "0" "0")]
[(char=? next-char #\1)
(token "1" "1")])))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "1"))))
'(rule "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "1"))))
'(rule "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "01"))))
'(rule "0" "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "01"))))
'(rule "0" "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "001"))))
'(rule "0" "0" "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "001"))))
'(rule "0" "0" "1"))
(check-exn exn:fail:parsing?
(lambda ()
(parse #f (lex (open-input-string "0")))))
(check-exn exn:fail:parsing? (check-exn exn:fail:parsing?
(lambda () (lambda ()
(parse #f (lex (open-input-string "10"))))) (parse #f (lex (open-input-string "0")))))
(check-exn exn:fail:parsing? (check-exn exn:fail:parsing?
(lambda () (lambda ()
(parse #f (lex (open-input-string "010"))))) (parse #f (lex (open-input-string "10")))))
(check-exn exn:fail:parsing?
(lambda ()
(parse #f (lex (open-input-string "010")))))
;; This should fail predictably because we're passing in tokens
;; that the parser doesn't know. ;; This should fail predictably because we're passing in tokens
(check-exn exn:fail:parsing? ;; that the parser doesn't know.
(lambda () (parse '("zero" "one" "zero")))) (check-exn exn:fail:parsing?
(check-exn (regexp (regexp-quote (lambda () (parse '("zero" "one" "zero"))))
"Encountered unexpected token of type \"zero\" (value \"zero\") while parsing")) (check-exn (regexp (regexp-quote
(lambda () (parse '("zero" "one" "zero")))) "Encountered unexpected token of type \"zero\" (value \"zero\") while parsing"))
(lambda () (parse '("zero" "one" "zero")))))

75
tests/test-0n1n.rkt
Unescape Escape View File

@ -1,49 +1,52 @@
#lang racket/base #lang racket/base
(require yaragg/examples/0n1n
yaragg/support
rackunit)
(define (lex ip) (module+ test
(port-count-lines! ip)
(lambda ()
(define next-char (read-char ip))
(cond [(eof-object? next-char)
(token eof)]
[(char=? next-char #\0)
(token "0" "0")]
[(char=? next-char #\1)
(token "1" "1")])))
(require yaragg/examples/0n1n
yaragg/support
rackunit)
;; The only rule in the grammar is: (define (lex ip)
;; (port-count-lines! ip)
;; rule-0n1n: ["0" rule-0n1n "1"] (lambda ()
;; (define next-char (read-char ip))
;; It makes use of the "maybe" pattern. The result type of the (cond [(eof-object? next-char)
;; grammar rule is: (token eof)]
;; [(char=? next-char #\0)
;; rule-0n1n: (U #f (token "0" "0")]
;; (list "0" rule-0n1n "1")) [(char=? next-char #\1)
(token "1" "1")])))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "0011"))))
'(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "01")))) ;; The only rule in the grammar is:
'(rule-0n1n "0" (rule-0n1n) "1")) ;;
;; rule-0n1n: ["0" rule-0n1n "1"]
;;
;; It makes use of the "maybe" pattern. The result type of the
;; grammar rule is:
;;
;; rule-0n1n: (U #f
;; (list "0" rule-0n1n "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "")))) (check-equal? (syntax->datum (parse #f (lex (open-input-string "0011"))))
'(rule-0n1n)) '(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "000111")))) (check-equal? (syntax->datum (parse #f (lex (open-input-string "01"))))
'(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1") "1")) '(rule-0n1n "0" (rule-0n1n) "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string ""))))
'(rule-0n1n))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "000111"))))
'(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1") "1"))
(check-exn exn:fail:parsing?
(lambda () (parse #f (lex (open-input-string "0001111")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (lex (open-input-string "0001110")))))
(check-exn exn:fail:parsing? (check-exn exn:fail:parsing?
(lambda () (parse #f (lex (open-input-string "10001110"))))) (lambda () (parse #f (lex (open-input-string "0001111")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (lex (open-input-string "0001110")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (lex (open-input-string "10001110"))))))

26
tests/test-all.rkt
Unescape Escape View File

@ -1,26 +0,0 @@
#lang racket/base
(require yaragg/tests/test-0n1
yaragg/tests/test-0n1n
yaragg/tests/test-01-equal
yaragg/tests/test-baby-json
yaragg/tests/test-baby-json-hider
yaragg/tests/test-curly-quantifier
yaragg/tests/test-cutter
yaragg/tests/test-empty-symbol
yaragg/tests/test-errors
yaragg/tests/test-flatten
yaragg/tests/test-hide-and-splice
yaragg/tests/test-lexer
yaragg/tests/test-nested-repeats
yaragg/tests/test-old-token
yaragg/tests/test-parser
yaragg/tests/test-quotation-marks-and-backslashes
yaragg/tests/test-simple-arithmetic-grammar
yaragg/tests/test-simple-line-drawing
yaragg/tests/test-start-and-atok
yaragg/tests/test-top-level-cut
yaragg/tests/test-weird-grammar
yaragg/tests/test-whitespace
yaragg/tests/test-wordy
(submod yaragg/codegen/satisfaction test))

49
tests/test-baby-json-hider.rkt
Unescape Escape View File

@ -1,27 +1,30 @@
#lang racket/base #lang racket/base
(require yaragg/examples/baby-json-hider
yaragg/support
rackunit)
(define parse-result (parse (list "{" (module+ test
(token 'ID "message")
":"
(token 'STRING "'hello world'")
"}")))
(check-equal? (syntax->datum parse-result) '(json (":")))
(define syntaxed-colon-parens (cadr (syntax->list parse-result))) (require yaragg/examples/baby-json-hider
(check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'kvpair)) 'kvpair) yaragg/support
rackunit)
(check-equal? (define parse-result (parse (list "{"
(syntax->datum (token 'ID "message")
(parse "[[[{}]],[],[[{}]]]")) ":"
'(json (token 'STRING "'hello world'")
(array "}")))
"[" (check-equal? (syntax->datum parse-result) '(json (":")))
(json (array "[" (json (array "[" (json) "]")) "]"))
"," (define syntaxed-colon-parens (cadr (syntax->list parse-result)))
(json (array "[" "]")) (check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'kvpair)) 'kvpair)
","
(json (array "[" (json (array "[" (json) "]")) "]")) (check-equal?
"]"))) (syntax->datum
(parse "[[[{}]],[],[[{}]]]"))
'(json
(array
"["
(json (array "[" (json (array "[" (json) "]")) "]"))
","
(json (array "[" "]"))
","
(json (array "[" (json (array "[" (json) "]")) "]"))
"]"))))

55
tests/test-baby-json.rkt
Unescape Escape View File

@ -1,30 +1,33 @@
#lang racket/base #lang racket/base
(require yaragg/examples/baby-json
(prefix-in alt: yaragg/examples/baby-json-alt)
yaragg/support
rackunit)
(let ([str (list "{" (module+ test
(token 'ID "message")
":"
(token 'STRING "'hello world'")
"}")]
[result '(json (object "{"
(kvpair "message" ":" (json (string "'hello world'")))
"}"))])
(check-equal? (parse-to-datum str) result)
(check-equal? (alt:parse-to-datum str) result))
(require yaragg/examples/baby-json
(prefix-in alt: yaragg/examples/baby-json-alt)
yaragg/support
rackunit)
(let ([str "[[[{}]],[],[[{}]]]"] (let ([str (list "{"
[result '(json (token 'ID "message")
(array ":"
"[" (token 'STRING "'hello world'")
(json (array "[" (json (array "[" (json (object "{" "}")) "]")) "]")) "}")]
"," [result '(json (object "{"
(json (array "[" "]")) (kvpair "message" ":" (json (string "'hello world'")))
"," "}"))])
(json (array "[" (json (array "[" (json (object "{" "}")) "]")) "]")) (check-equal? (parse-to-datum str) result)
"]"))]) (check-equal? (alt:parse-to-datum str) result))
(check-equal? (parse-to-datum str) result)
(check-equal? (alt:parse-to-datum str) result))
(let ([str "[[[{}]],[],[[{}]]]"]
[result '(json
(array
"["
(json (array "[" (json (array "[" (json (object "{" "}")) "]")) "]"))
","
(json (array "[" "]"))
","
(json (array "[" (json (array "[" (json (object "{" "}")) "]")) "]"))
"]"))])
(check-equal? (parse-to-datum str) result)
(check-equal? (alt:parse-to-datum str) result)))

16
tests/test-codepoints.rkt
Unescape Escape View File

@ -1,10 +1,12 @@
#lang racket/base #lang racket/base
(require yaragg/examples/codepoints (module+ test
rackunit)
(check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\\"\\ef\"" "hello world")) (require yaragg/examples/codepoints
'(start (A "\"A\\") rackunit)
(c "'c\\")
(def "*d\\\"\\ef\"") (check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\\"\\ef\"" "hello world"))
(hello-world "hello world"))) '(start (A "\"A\\")
(c "'c\\")
(def "*d\\\"\\ef\"")
(hello-world "hello world"))))

59
tests/test-curly-quantifier.rkt
Unescape Escape View File

@ -1,28 +1,33 @@
#lang racket/base #lang racket/base
(require yaragg/examples/curly-quantifier
yaragg/support (module+ test
rackunit)
(require yaragg/examples/curly-quantifier
(check-exn exn:fail:parsing? (λ () (parse-to-datum "a"))) yaragg/support
(check-equal? (parse-to-datum "aa") '(start (a-rule "a" "a"))) rackunit)
(check-exn exn:fail:parsing? (λ () (parse-to-datum "aaa")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "a")))
(check-equal? (parse-to-datum "") '(start (b-rule))) (check-equal? (parse-to-datum "aa") '(start (a-rule "a" "a")))
(check-equal? (parse-to-datum "b") '(start (b-rule "b"))) (check-exn exn:fail:parsing? (λ () (parse-to-datum "aaa")))
(check-equal? (parse-to-datum "bb") '(start (b-rule "b" "b")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "bbb"))) (check-equal? (parse-to-datum "") '(start (b-rule)))
(check-equal? (parse-to-datum "b") '(start (b-rule "b")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "c"))) (check-equal? (parse-to-datum "bb") '(start (b-rule "b" "b")))
(check-equal? (parse-to-datum "cc") '(start (c-rule "c" "c"))) (check-exn exn:fail:parsing? (λ () (parse-to-datum "bbb")))
(check-equal? (parse-to-datum "ccc") '(start (c-rule "c" "c" "c")))
(check-equal? (parse-to-datum "cccc") '(start (c-rule "c" "c" "c" "c"))) (check-exn exn:fail:parsing? (λ () (parse-to-datum "c")))
(check-equal? (parse-to-datum "cc") '(start (c-rule "c" "c")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "d"))) (check-equal? (parse-to-datum "ccc") '(start (c-rule "c" "c" "c")))
(check-equal? (parse-to-datum "dd") '(start (d-rule "d" "d"))) (check-equal? (parse-to-datum "cccc") '(start (c-rule "c" "c" "c" "c")))
(check-equal? (parse-to-datum "ddd") '(start (d-rule "d" "d" "d")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "dddd"))) (check-exn exn:fail:parsing? (λ () (parse-to-datum "d")))
(check-equal? (parse-to-datum "dd") '(start (d-rule "d" "d")))
(check-equal? (syntax->datum ((make-rule-parser e-rule) "")) '(e-rule)) ; to prevent ambiguity with b-rule while parsing empty string (check-equal? (parse-to-datum "ddd") '(start (d-rule "d" "d" "d")))
(check-equal? (parse-to-datum "e") '(start (e-rule "e"))) (check-exn exn:fail:parsing? (λ () (parse-to-datum "dddd")))
(check-equal? (parse-to-datum "ee") '(start (e-rule "e" "e")))
(check-equal? (parse-to-datum "eee") '(start (e-rule "e" "e" "e"))) ; to prevent ambiguity with b-rule while parsing empty string
(check-equal? (syntax->datum ((make-rule-parser e-rule) "")) '(e-rule))
(check-equal? (parse-to-datum "e") '(start (e-rule "e")))
(check-equal? (parse-to-datum "ee") '(start (e-rule "e" "e")))
(check-equal? (parse-to-datum "eee") '(start (e-rule "e" "e" "e"))))

23
tests/test-cutter-another.rkt
Unescape Escape View File

@ -1,12 +1,15 @@
#lang racket/base #lang racket/base
(require yaragg/examples/cutter-another
yaragg/support
rackunit)
(check-equal? (parse-tree "w") '(top (w))) (module+ test
(check-equal? (parse-tree "x") '(top (x)))
(check-equal? (parse-tree "yy") '(top (y))) (require yaragg/examples/cutter-another
(check-equal? (parse-tree "z") '(top (z))) yaragg/support
(check-equal? (parse-tree "a") '(top (a))) rackunit)
(check-equal? (parse-tree "bb") '(top (b)))
(check-equal? (parse-tree "c") '(top (c))) (check-equal? (parse-tree "w") '(top (w)))
(check-equal? (parse-tree "x") '(top (x)))
(check-equal? (parse-tree "yy") '(top (y)))
(check-equal? (parse-tree "z") '(top (z)))
(check-equal? (parse-tree "a") '(top (a)))
(check-equal? (parse-tree "bb") '(top (b)))
(check-equal? (parse-tree "c") '(top (c))))

17
tests/test-cutter.rkt
Unescape Escape View File

@ -1,9 +1,12 @@
#lang racket/base #lang racket/base
(require yaragg/examples/cutter
yaragg/support
rackunit)
;; related to rule-flattening problem (module+ test
(check-equal?
(parse-to-datum (list "(" "x" "," "x" ")")) (require yaragg/examples/cutter
'(top (expr (list "(" (expr "x") "," (expr "x") ")")))) yaragg/support
rackunit)
;; related to rule-flattening problem
(check-equal?
(parse-to-datum (list "(" "x" "," "x" ")"))
'(top (expr (list "(" (expr "x") "," (expr "x") ")")))))

35
tests/test-empty-symbol.rkt
Unescape Escape View File

@ -1,21 +1,24 @@
#lang racket/base #lang racket/base
(require yaragg/examples/empty-symbol
yaragg/support
rackunit)
(check-true (and (member (parse-to-datum "") (list '(top (xs)) '(top (ys)) '(top (zs)))) #t)) (module+ test
;; x is normal (require yaragg/examples/empty-symbol
(check-equal? (parse-to-datum "x") '(top (xs "x" (xs)))) yaragg/support
(check-equal? (parse-to-datum "xx") '(top (xs "x" (xs "x" (xs))))) rackunit)
(check-equal? (parse-to-datum "xxx") '(top (xs "x" (xs "x" (xs "x" (xs))))))
;; y cuts (check-true (and (member (parse-to-datum "") (list '(top (xs)) '(top (ys)) '(top (zs)))) #t))
(check-equal? (parse-to-datum "y") '(top (ys "y")))
(check-equal? (parse-to-datum "yy") '(top (ys "y")))
(check-equal? (parse-to-datum "yyy") '(top (ys "y")))
;; z splices ;; x is normal
(check-equal? (parse-to-datum "z") '(top (zs "z"))) (check-equal? (parse-to-datum "x") '(top (xs "x" (xs))))
(check-equal? (parse-to-datum "zz") '(top (zs "z" "z"))) (check-equal? (parse-to-datum "xx") '(top (xs "x" (xs "x" (xs)))))
(check-equal? (parse-to-datum "zzz") '(top (zs "z" "z" "z"))) (check-equal? (parse-to-datum "xxx") '(top (xs "x" (xs "x" (xs "x" (xs))))))
;; y cuts
(check-equal? (parse-to-datum "y") '(top (ys "y")))
(check-equal? (parse-to-datum "yy") '(top (ys "y")))
(check-equal? (parse-to-datum "yyy") '(top (ys "y")))
;; z splices
(check-equal? (parse-to-datum "z") '(top (zs "z")))
(check-equal? (parse-to-datum "zz") '(top (zs "z" "z")))
(check-equal? (parse-to-datum "zzz") '(top (zs "z" "z" "z"))))

126
tests/test-errors.rkt
Unescape Escape View File

@ -1,137 +1,139 @@
#lang racket/base #lang racket/base
(require rackunit (module+ test
(for-syntax racket/base))
;; The tests in this module make sure we produce proper error messages (require rackunit
;; on weird grammars. (for-syntax racket/base))
;; The tests in this module make sure we produce proper error messages
;; on weird grammars.
(define-namespace-anchor anchor)
(define ns (namespace-anchor->namespace anchor))
(define (c prog)
(parameterize ([current-namespace ns]
[read-accept-reader #t])
(define ip (open-input-string prog))
(port-count-lines! ip)
(compile (read-syntax #f ip))))
(define-namespace-anchor anchor)
(define ns (namespace-anchor->namespace anchor))
(define (c prog)
(parameterize ([current-namespace ns]
[read-accept-reader #t])
(define ip (open-input-string prog))
(port-count-lines! ip)
(compile (read-syntax #f ip))))
;; Helper to let me quickly write compile-error checks.
(define-syntax (check-compile-error stx)
(syntax-case stx ()
[(_ prog expected-msg)
(quasisyntax/loc stx
(begin #,(syntax/loc stx
(check-exn (regexp (regexp-quote expected-msg))
(lambda ()
(c prog))))
#,(syntax/loc stx
(check-exn exn:fail:syntax?
(lambda ()
(c prog))))))]))
;; Helper to let me quickly write compile-error checks.
(define-syntax (check-compile-error stx)
(syntax-case stx ()
[(_ prog expected-msg)
(quasisyntax/loc stx
(begin #,(syntax/loc stx
(check-exn (regexp (regexp-quote expected-msg))
(lambda ()
(c prog))))
#,(syntax/loc stx
(check-exn exn:fail:syntax?
(lambda ()
(c prog))))))]))
;; errors with position are sensitive to length of lang line
(define lang-line "#lang yaragg")
(check-compile-error (format "~a" lang-line) ;; errors with position are sensitive to length of lang line
"The grammar does not appear to have any rules") (define lang-line "#lang yaragg")
(check-compile-error (format "~a\nfoo" lang-line) (check-compile-error (format "~a" lang-line)
"Error while parsing grammar near: foo [line=2, column=0, position=14]") "The grammar does not appear to have any rules")
(check-compile-error (format "~a\nnumber : 42" lang-line) (check-compile-error (format "~a\nfoo" lang-line)
"Error while parsing grammar near: 42 [line=2, column=9, position=23]") "Error while parsing grammar near: foo [line=2, column=0, position=14]")
(check-compile-error (format "~a\nnumber : 1" lang-line) (check-compile-error (format "~a\nnumber : 42" lang-line)
"Error while parsing grammar near: 1 [line=2, column=9, position=23]") "Error while parsing grammar near: 42 [line=2, column=9, position=23]")
(check-compile-error (format "~a\nnumber : 1" lang-line)
"Error while parsing grammar near: 1 [line=2, column=9, position=23]")
(check-compile-error "#lang yaragg\n x: NUMBER\nx:STRING"
"Rule x has a duplicate definition")
;; Check to see that missing definitions for rules also raise good syntax (check-compile-error "#lang yaragg\n x: NUMBER\nx:STRING"
;; errors: "Rule x has a duplicate definition")
(check-compile-error "#lang yaragg\nx:y" ;; Check to see that missing definitions for rules also raise good syntax
"Rule y has no definition") ;; errors:
(check-compile-error "#lang yaragg\nnumber : 1flarbl" (check-compile-error "#lang yaragg\nx:y"
"Rule 1flarbl has no definition") "Rule y has no definition")
(check-compile-error "#lang yaragg\nnumber : 1flarbl"
"Rule 1flarbl has no definition")
(check-compile-error "#lang yaragg\nprogram: EOF"
"Token EOF is reserved and can not be used in a grammar")
(check-compile-error "#lang yaragg\nprogram: EOF"
"Token EOF is reserved and can not be used in a grammar")
;; Nontermination checks:
(check-compile-error "#lang yaragg\nx : x"
"Rule x has no finite derivation")
;; Nontermination checks:
(check-compile-error "#lang yaragg\nx : x"
"Rule x has no finite derivation")
(check-compile-error #<<EOF
(check-compile-error #<<EOF
#lang yaragg #lang yaragg
x : x y x : x y
y : "y" y : "y"
EOF EOF
"Rule x has no finite derivation") "Rule x has no finite derivation")
; This should be illegal too: ; This should be illegal too:
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang yaragg #lang yaragg
a : "a" b a : "a" b
b : a | b b : a | b
EOF EOF
"Rule a has no finite derivation") "Rule a has no finite derivation")
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang yaragg #lang yaragg
a : [b] a : [b]
b : [c] b : [c]
c : c c : c
EOF EOF
"Rule c has no finite derivation") "Rule c has no finite derivation")
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang yaragg #lang yaragg
a : [b] a : [b]
b : c b : c
c : c c : c
EOF EOF
"Rule b has no finite derivation") "Rule b has no finite derivation")
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang yaragg #lang yaragg
a : [a] a : [a]
b : [b] b : [b]
c : c c : c
EOF EOF
"Rule c has no finite derivation") "Rule c has no finite derivation")
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang racket/base #lang racket/base
(require yaragg/examples/simple-line-drawing) (require yaragg/examples/simple-line-drawing)
(define bad-parser (make-rule-parser crunchy)) (define bad-parser (make-rule-parser crunchy))
EOF EOF
"Rule crunchy is not defined in the grammar" "Rule crunchy is not defined in the grammar"
) ))

390
tests/test-flatten.rkt
Unescape Escape View File

@ -1,204 +1,206 @@
#lang racket/base #lang racket/base
(require yaragg/rules/stx-types
yaragg/codegen/flatten
rackunit)
(module+ test
(define (make-fresh-name) (require yaragg/rules/stx-types
(let ([n 0]) yaragg/codegen/flatten
(lambda () rackunit)
(set! n (add1 n))
(string->symbol (format "r~a" n)))))
;; Simple literals (define (make-fresh-name)
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (lit "hello")))) (let ([n 0])
'((prim-rule lit expr [(lit "hello")]))) (lambda ()
(set! n (add1 n))
(check-equal? (map syntax->datum (string->symbol (format "r~a" n)))))
(flatten-rule #'(rule expr
(seq (lit "hello")
(lit "world")))))
'((prim-rule seq expr [(lit "hello") (lit "world")])))
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (token HELLO))))
'((prim-rule token expr [(token HELLO)])))
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (id rule-2)))) ;; Simple literals
'((prim-rule id expr [(id rule-2)]))) (check-equal? (map syntax->datum (flatten-rule #'(rule expr (lit "hello"))))
'((prim-rule lit expr [(lit "hello")])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr
(seq (lit "hello")
(lit "world")))))
'((prim-rule seq expr [(lit "hello") (lit "world")])))
;; Sequences of primitives
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (lit "1") (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum (flatten-rule #'(rule expr (token HELLO))))
(flatten-rule #'(rule expr (seq (seq (lit "1") (lit "2")) (lit "3"))))) '((prim-rule token expr [(token HELLO)])))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")]))) (check-equal? (map syntax->datum (flatten-rule #'(rule expr (id rule-2))))
'((prim-rule id expr [(id rule-2)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (seq (lit "1")) (seq (lit "2") (lit "3")))))) ;; Sequences of primitives
'((prim-rule seq expr (check-equal? (map syntax->datum
[(lit "1") (lit "2") (lit "3")]))) (flatten-rule #'(rule expr (seq (lit "1") (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
;; choices (check-equal? (map syntax->datum
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (seq (seq (lit "1") (lit "2")) (lit "3")))))
(flatten-rule #'(rule expr (choice (id rule-2) (id rule-3))))) '((prim-rule seq expr
'((prim-rule choice expr [(lit "1") (lit "2") (lit "3")])))
[(id rule-2)]
[(id rule-3)])))
(check-equal? (map syntax->datum
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (seq (seq (lit "1")) (seq (lit "2") (lit "3"))))))
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")")) '((prim-rule seq expr
(seq))) [(lit "1") (lit "2") (lit "3")])))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (lit ")")] [])))
;; choices
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH)) (flatten-rule #'(rule expr (choice (id rule-2) (id rule-3)))))
(lit ")")) '((prim-rule choice expr
(seq))) [(id rule-2)]
#:fresh-name (make-fresh-name))) [(id rule-3)])))
'((prim-rule choice sexp
[(lit "(") (token BLAH) (lit ")")] []))) (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
;; maybe [(lit "(") (lit ")")] [])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (id rule-2))))) (check-equal? (map syntax->datum
'((prim-rule maybe expr (flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH))
[(id rule-2)] (lit ")"))
[]))) (seq)))
(check-equal? (map syntax->datum #:fresh-name (make-fresh-name)))
(flatten-rule #'(rule expr (maybe (token HUH))))) '((prim-rule choice sexp
'((prim-rule maybe expr [(lit "(") (token BLAH) (lit ")")] [])))
[(token HUH)]
[])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
'((prim-rule maybe expr ;; maybe
[(lit "hello") (lit "world")] (check-equal? (map syntax->datum
[]))) (flatten-rule #'(rule expr (maybe (id rule-2)))))
'((prim-rule maybe expr
[(id rule-2)]
[])))
(check-equal? (map syntax->datum
;; repeat (flatten-rule #'(rule expr (maybe (token HUH)))))
(check-equal? (map syntax->datum '((prim-rule maybe expr
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2))))) [(token HUH)]
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ()) [])))
(inferred-prim-rule repeat %rule1 (check-equal? (map syntax->datum
((inferred-id %rule1 repeat) (id rule-2)) (flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
((id rule-2))))) '((prim-rule maybe expr
(check-equal? (map syntax->datum [(lit "hello") (lit "world")]
(flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2)))))) [])))
'((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
(inferred-prim-rule repeat %rule2
((inferred-id %rule2 repeat) (lit "+") (id rule-2))
((lit "+") (id rule-2)))))
;; repeat
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2))))) (flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule repeat rule-2+ '((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
[(inferred-id rule-2+ repeat) (id rule-2)] (inferred-prim-rule repeat %rule1
[(id rule-2)]))) ((inferred-id %rule1 repeat) (id rule-2))
(check-equal? (map syntax->datum ((id rule-2)))))
(flatten-rule #'(rule rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2)))))) (check-equal? (map syntax->datum
'((prim-rule repeat rule-2+ (flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2))))))
[(inferred-id rule-2+ repeat) (lit "-") (id rule-2)] '((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
[(lit "-") (id rule-2)]))) (inferred-prim-rule repeat %rule2
((inferred-id %rule2 repeat) (lit "+") (id rule-2))
((lit "+") (id rule-2)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
'((prim-rule repeat rule-2+
;; Mixtures [(inferred-id rule-2+ repeat) (id rule-2)]
[(id rule-2)])))
;; choice and maybe (check-equal? (map syntax->datum
(check-equal? (map syntax->datum (flatten-rule #'(rule rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2))))))
(flatten-rule #'(rule sexp (choice (lit "x") '((prim-rule repeat rule-2+
(maybe (lit "y")))) [(inferred-id rule-2+ repeat) (lit "-") (id rule-2)]
#:fresh-name (make-fresh-name))) [(lit "-") (id rule-2)])))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(lit "y")]
[])))
;; choice, maybe, repeat ;; Mixtures
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x") ;; choice and maybe
(maybe (repeat 1 #f (lit "y"))))) (check-equal? (map syntax->datum
#:fresh-name (make-fresh-name))) (flatten-rule #'(rule sexp (choice (lit "x")
'((prim-rule choice sexp (maybe (lit "y"))))
[(lit "x")] #:fresh-name (make-fresh-name)))
[(inferred-id r1 maybe)]) '((prim-rule choice sexp
(inferred-prim-rule maybe r1 [(lit "x")]
[(inferred-id r2 repeat)] [(inferred-id r1 maybe)])
[]) (inferred-prim-rule maybe r1
(inferred-prim-rule repeat r2 [(lit "y")]
[(inferred-id r2 repeat) (lit "y")] [])))
[(lit "y")]))) ;; choice, maybe, repeat
;; choice, seq (check-equal? (map syntax->datum
(check-equal? (map syntax->datum (flatten-rule #'(rule sexp (choice (lit "x")
(flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y")) (maybe (repeat 1 #f (lit "y")))))
(seq (lit "z") (lit "w")))) #:fresh-name (make-fresh-name)))
#:fresh-name (make-fresh-name))) '((prim-rule choice sexp
'((prim-rule choice sexp [(lit "x")]
[(lit "x") (lit "y")] [(inferred-id r1 maybe)])
[(lit "z") (lit "w")]))) (inferred-prim-rule maybe r1
[(inferred-id r2 repeat)]
;; maybe, choice [])
(check-equal? (map syntax->datum (inferred-prim-rule repeat r2
(flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y")) [(inferred-id r2 repeat) (lit "y")]
(seq (lit "z") (lit "w"))))) [(lit "y")])))
#:fresh-name (make-fresh-name))) ;; choice, seq
'((prim-rule maybe sexp (check-equal? (map syntax->datum
[(inferred-id r1 choice)] (flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y"))
[]) (seq (lit "z") (lit "w"))))
(inferred-prim-rule choice r1 #:fresh-name (make-fresh-name)))
[(lit "x") (lit "y")] '((prim-rule choice sexp
[(lit "z") (lit "w")]))) [(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; seq, repeat ;; maybe, choice
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))) (flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y"))
#:fresh-name (make-fresh-name))) (seq (lit "z") (lit "w")))))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat))) #:fresh-name (make-fresh-name)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ()) '((prim-rule maybe sexp
(inferred-prim-rule repeat r2 [(inferred-id r1 choice)]
((inferred-id r2 repeat) (lit "+") (id term)) [])
((lit "+") (id term))))) (inferred-prim-rule choice r1
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; larger example: simple arithmetic
(check-equal? (map syntax->datum
(flatten-rules (syntax->list (test-case "seq, repeat"
#'((rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))) (define rule-stx #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))))
(rule term (seq (id factor) (repeat 0 #f (seq (lit "*") (id factor))))) (check-equal? (map syntax->datum (flatten-rule rule-stx #:fresh-name (make-fresh-name)))
(rule factor (token INT)))) '((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
#:fresh-name (make-fresh-name))) (prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
'((prim-rule seq expr ((id term) (inferred-id r1 repeat))) ((inferred-id r2 repeat) (lit "+") (id term))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ()) ((lit "+") (id term))))))
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term))) (test-case "larger example: simple arithmetic"
(prim-rule seq term ((id factor) (inferred-id r3 repeat))) (define rule-stxs
(prim-rule maybe r3 ((inferred-id r4 repeat)) ()) (syntax->list
(inferred-prim-rule repeat r4 #'((rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
((inferred-id r4 repeat) (lit "*") (id factor)) (rule term (seq (id factor) (repeat 0 #f (seq (lit "*") (id factor)))))
((lit "*") (id factor))) (rule factor (token INT)))))
(prim-rule token factor ((token INT))))) (check-equal? (map syntax->datum (flatten-rules rule-stxs #:fresh-name (make-fresh-name)))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term)))
(prim-rule seq term ((id factor) (inferred-id r3 repeat)))
(prim-rule maybe r3 ((inferred-id r4 repeat)) ())
(inferred-prim-rule repeat r4
((inferred-id r4 repeat) (lit "*") (id factor))
((lit "*") (id factor)))
(prim-rule token factor ((token INT)))))))

15
tests/test-hide-and-splice.rkt
Unescape Escape View File

@ -1,9 +1,12 @@
#lang racket/base #lang racket/base
(require yaragg/examples/hide-and-splice
yaragg/support
rackunit)
;; check that an id with both a splice and hide is handled correctly (module+ test
(check-equal? (parse-to-datum "xxx") '(top ("x" "x" "x"))) (require yaragg/examples/hide-and-splice
(check-equal? (parse-to-datum "yyy") '(top "y" "y" "y")) yaragg/support
rackunit)
;; check that an id with both a splice and hide is handled correctly
(check-equal? (parse-to-datum "xxx") '(top ("x" "x" "x")))
(check-equal? (parse-to-datum "yyy") '(top "y" "y" "y")))

110
tests/test-lexer.rkt
Unescape Escape View File

@ -1,75 +1,79 @@
#lang racket/base #lang racket/base
(require yaragg/rules/lexer
rackunit
yaragg/parser-tools/lex)
(define (l s) (module+ test
(define t (lex/1 (open-input-string s)))
(list (token-name (position-token-token t))
(token-value (position-token-token t))
(position-offset (position-token-start-pos t))
(position-offset (position-token-end-pos t))))
;; WARNING: the offsets are not in terms of file positions. So they (require yaragg/rules/lexer
;; start counting at 1, not 0. rackunit
(check-equal? (l " hi") yaragg/parser-tools/lex)
'(ID "hi" 2 4))
(check-equal? (l " hi") (define (l s)
'(ID "hi" 3 5)) (define t (lex/1 (open-input-string s)))
(list (token-name (position-token-token t))
(token-value (position-token-token t))
(position-offset (position-token-start-pos t))
(position-offset (position-token-end-pos t))))
(check-equal? (l "hi") ;; WARNING: the offsets are not in terms of file positions. So they
'(ID "hi" 1 3)) ;; start counting at 1, not 0.
(check-equal? (l " hi")
'(ID "hi" 2 4))
(check-equal? (l "# foobar\nhi") (check-equal? (l " hi")
'(ID "hi" 10 12)) '(ID "hi" 3 5))
(check-equal? (l "# foobar\rhi") (check-equal? (l "hi")
'(ID "hi" 10 12)) '(ID "hi" 1 3))
(check-equal? (l "# foobar\r\nhi") (check-equal? (l "# foobar\nhi")
'(ID "hi" 11 13)) '(ID "hi" 10 12))
(check-equal? (l "hi:") (check-equal? (l "# foobar\rhi")
'(RULE_HEAD "hi:" 1 4)) '(ID "hi" 10 12))
(check-equal? (l "hi :") (check-equal? (l "# foobar\r\nhi")
'(RULE_HEAD "hi :" 1 7)) '(ID "hi" 11 13))
(check-equal? (l "|") (check-equal? (l "hi:")
'(PIPE "|" 1 2)) '(RULE_HEAD "hi:" 1 4))
(check-equal? (l "(") (check-equal? (l "hi :")
'(LPAREN "(" 1 2)) '(RULE_HEAD "hi :" 1 7))
(check-equal? (l "[") (check-equal? (l "|")
'(LBRACKET "[" 1 2)) '(PIPE "|" 1 2))
(check-equal? (l ")") (check-equal? (l "(")
'(RPAREN ")" 1 2)) '(LPAREN "(" 1 2))
(check-equal? (l "]") (check-equal? (l "[")
'(RBRACKET "]" 1 2)) '(LBRACKET "[" 1 2))
;; 220111: lexer now converts single-quoted lexemes (check-equal? (l ")")
;; to standard Racket-style double-quoted string literal '(RPAREN ")" 1 2))
(check-equal? (l "'hello'")
'(LIT "\"hello\"" 1 8))
(check-equal? (l "'he\\'llo'") (check-equal? (l "]")
'(LIT "\"he'llo\"" 1 10)) '(RBRACKET "]" 1 2))
(check-equal? (l "/") ;; 220111: lexer now converts single-quoted lexemes
'(HIDE "/" 1 2)) ;; to standard Racket-style double-quoted string literal
(check-equal? (l "'hello'")
'(LIT "\"hello\"" 1 8))
(check-equal? (l " /") (check-equal? (l "'he\\'llo'")
'(HIDE "/" 2 3)) '(LIT "\"he'llo\"" 1 10))
(check-equal? (l "@") (check-equal? (l "/")
'(SPLICE "@" 1 2)) '(HIDE "/" 1 2))
(check-equal? (l " @") (check-equal? (l " /")
'(SPLICE "@" 2 3)) '(HIDE "/" 2 3))
(check-equal? (l "#:prefix-out val:") (check-equal? (l "@")
(list 'EOF eof 18 18)) ; lexer skips kwarg '(SPLICE "@" 1 2))
(check-equal? (l " @")
'(SPLICE "@" 2 3))
; lexer skips kwarg
(check-equal? (l "#:prefix-out val:")
(list 'EOF eof 18 18)))

24
tests/test-make-rule-parser.rkt
Unescape Escape View File

@ -1,17 +1,19 @@
#lang racket/base #lang racket/base
(require rackunit
yaragg/support
yaragg/examples/subrule)
(define parse-next (make-rule-parser next)) (module+ test
(define parse-start (make-rule-parser start))
(check-equal? (syntax->datum (parse #f "0")) '(start (next "0"))) (require rackunit
(check-equal? (syntax->datum (parse #f "0")) (syntax->datum (parse "0"))) yaragg/support
yaragg/examples/subrule)
(check-equal? (syntax->datum (parse-start #f "0")) '(start (next "0"))) (define parse-next (make-rule-parser next))
(check-equal? (syntax->datum (parse-start #f "0")) (syntax->datum (parse-start "0"))) (define parse-start (make-rule-parser start))
(check-equal? (syntax->datum (parse-next #f "0")) '(next "0")) (check-equal? (syntax->datum (parse #f "0")) '(start (next "0")))
(check-equal? (syntax->datum (parse-next #f "0")) (syntax->datum (parse-next "0"))) (check-equal? (syntax->datum (parse #f "0")) (syntax->datum (parse "0")))
(check-equal? (syntax->datum (parse-start #f "0")) '(start (next "0")))
(check-equal? (syntax->datum (parse-start #f "0")) (syntax->datum (parse-start "0")))
(check-equal? (syntax->datum (parse-next #f "0")) '(next "0"))
(check-equal? (syntax->datum (parse-next #f "0")) (syntax->datum (parse-next "0"))))

11
tests/test-nested-repeats.rkt
Unescape Escape View File

@ -1,9 +1,10 @@
#lang racket/base #lang racket/base
(require yaragg/examples/nested-repeats
rackunit)
(check-equal? (module+ test
(syntax->datum (parse (list "X" "Y" "X")))
'(start "X" "Y" "X"))
(require yaragg/examples/nested-repeats
rackunit)
(check-equal?
(syntax->datum (parse (list "X" "Y" "X")))
'(start "X" "Y" "X")))

110
tests/test-old-token.rkt
Unescape Escape View File

@ -2,72 +2,74 @@
;; Make sure the old token type also works fine. ;; Make sure the old token type also works fine.
(require yaragg/examples/simple-line-drawing (module+ test
yaragg/support
racket/list (require yaragg/examples/simple-line-drawing
yaragg/parser-tools/lex yaragg/support
(prefix-in : yaragg/parser-tools/lex-sre) racket/list
rackunit) yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
(define-tokens tokens (INTEGER STRING |;| EOF)) rackunit)
(define (make-tokenizer ip) (define-tokens tokens (INTEGER STRING |;| EOF))
(port-count-lines! ip)
(define lex (lexer-src-pos (define (make-tokenizer ip)
[(:+ numeric) (port-count-lines! ip)
(token-INTEGER (string->number lexeme))] (define lex (lexer-src-pos
[upper-case [(:+ numeric)
(token-STRING lexeme)] (token-INTEGER (string->number lexeme))]
["b" [upper-case
(token-STRING " ")] (token-STRING lexeme)]
[";" ["b"
(|token-;| lexeme)] (token-STRING " ")]
[whitespace [";"
(return-without-pos (lex input-port))] (|token-;| lexeme)]
[(eof) [whitespace
(token-EOF 'eof)])) (return-without-pos (lex input-port))]
(lambda () [(eof)
(lex ip))) (token-EOF 'eof)]))
(lambda ()
(lex ip)))
(define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF
(define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF
3 9 X; 3 9 X;
6 3 b 3 X 3 b; 6 3 b 3 X 3 b;
3 9 X; 3 9 X;
EOF EOF
)))) ))))
(check-true (syntax-original? the-parsed-object-stx)) (check-true (syntax-original? the-parsed-object-stx))
;; Does the rule name "drawing" also have the proper "original?" property set? ;; Does the rule name "drawing" also have the proper "original?" property set?
(check-true (syntax-original? (first (syntax->list the-parsed-object-stx)))) (check-true (syntax-original? (first (syntax->list the-parsed-object-stx))))
(check-equal? (syntax->datum the-parsed-object-stx) (check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";") '(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";") (rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(rows (repeat 3) (chunk 9 "X") ";"))) (rows (repeat 3) (chunk 9 "X") ";")))
(define the-parsed-object (syntax->list the-parsed-object-stx)) (define the-parsed-object (syntax->list the-parsed-object-stx))
(check-equal? (syntax-line the-parsed-object-stx) 1) (check-equal? (syntax-line the-parsed-object-stx) 1)
(check-equal? (syntax-column the-parsed-object-stx) 0) (check-equal? (syntax-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1) (check-equal? (syntax-position the-parsed-object-stx) 1)
(check-equal? (syntax-span the-parsed-object-stx) 28) (check-equal? (syntax-span the-parsed-object-stx) 28)
(check-equal? (length the-parsed-object) 4) (check-equal? (length the-parsed-object) 4)
(check-equal? (syntax->datum (second the-parsed-object)) (check-equal? (syntax->datum (second the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";")) '(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1) (check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (third the-parsed-object)) (check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")) '(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2) (check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (fourth the-parsed-object)) (check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";")) '(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3) (check-equal? (syntax-line (list-ref the-parsed-object 3)) 3))
;; FIXME: add tests to make sure location is as we expect. ;; FIXME: add tests to make sure location is as we expect.
;; ;;

367
tests/test-parser.rkt
Unescape Escape View File

@ -1,183 +1,196 @@
#lang racket/base #lang racket/base
(module+ test
(require rackunit
yaragg/parser-tools/lex (require rackunit
yaragg/rules/parser yaragg/parser-tools/lex
yaragg/rules/lexer yaragg/rules/parser
yaragg/rules/rule-structs) yaragg/rules/lexer
yaragg/rules/rule-structs)
;; quick-and-dirty helper for pos construction.
(define (p x) ;; quick-and-dirty helper for pos construction.
(pos x #f #f)) (define (p x)
(pos x #f #f))
;; FIXME: fix the test cases so they work on locations rather than just offsets.
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'"))) ;; FIXME: fix the test cases so they work on locations rather than just offsets.
(list (rule (p 1) (p 15) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 15)
(pattern-lit (p 8) (p 15) "hello" #f)))) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-lit (p 8) (p 15) "hello" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON")))
(list (rule (p 1) (p 13) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 13)
(pattern-token (p 8) (p 13) "COLON" #f)))) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-token (p 8) (p 13) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "/expr : COLON")))
(list (rule (p 1) (p 14) (check-equal? (grammar-parser (tokenize (open-input-string "/expr : COLON")))
(lhs-id (p 1) (p 6) "expr" ''hide) (list (rule (p 1) (p 14)
(pattern-token (p 9) (p 14) "COLON" #f)))) (lhs-id (p 1) (p 6) "expr" ''hide)
(pattern-token (p 9) (p 14) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "@expr : COLON")))
(list (rule (p 1) (p 14) (check-equal? (grammar-parser (tokenize (open-input-string "@expr : COLON")))
(lhs-id (p 1) (p 6) "expr" ''splice) (list (rule (p 1) (p 14)
(pattern-token (p 9) (p 14) "COLON" #f)))) (lhs-id (p 1) (p 6) "expr" ''splice)
(pattern-token (p 9) (p 14) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : /COLON COLON")))
(list (rule (p 1) (p 20) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /COLON COLON")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 20)
(pattern-seq (p 8) (p 20) (lhs-id (p 1) (p 5) "expr" #f)
(list (pattern-seq (p 8) (p 20)
(pattern-token (p 8) (p 14) "COLON" 'hide) (list
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-token (p 8) (p 14) "COLON" 'hide)
#f)))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON")))
(list (rule (p 1) (p 20) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 20)
(pattern-seq (p 8) (p 20) (lhs-id (p 1) (p 5) "expr" #f)
(list (pattern-seq (p 8) (p 20)
(pattern-id (p 8) (p 14) "thing" 'hide) (list
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-id (p 8) (p 14) "thing" 'hide)
#f)))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON")))
(list (rule (p 1) (p 20) (check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 20)
(pattern-seq (p 8) (p 20) (lhs-id (p 1) (p 5) "expr" #f)
(list (pattern-seq (p 8) (p 20)
(pattern-id (p 8) (p 14) "thing" 'splice) (list
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-id (p 8) (p 14) "thing" 'splice)
#f)))) (pattern-token (p 15) (p 20) "COLON" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*")))
(list (rule (p 1) (p 16) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 16)
(pattern-repeat (p 8) (p 16) (lhs-id (p 1) (p 5) "expr" #f)
0 #f (pattern-repeat (p 8) (p 16)
(pattern-lit (p 8) (p 15) "hello" #f) 0 #f
#f)))) (pattern-lit (p 8) (p 15) "hello" #f)
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+")))
(list (rule (p 1) (p 16) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 16)
(pattern-repeat (p 8) (p 16) (lhs-id (p 1) (p 5) "expr" #f)
1 #f (pattern-repeat (p 8) (p 16)
(pattern-lit (p 8) (p 15) "hello" #f) 1 #f
#f)))) (pattern-lit (p 8) (p 15) "hello" #f)
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']")))
(list (rule (p 1) (p 18) (check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 18)
#;(pattern-maybe (p 8) (p 18) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-lit (p 9) (p 17) "hello" 'hide)) #;(pattern-maybe (p 8) (p 18)
(pattern-repeat (p 8) (p 18) (pattern-lit (p 9) (p 17) "hello" 'hide))
0 1 (pattern-repeat (p 8) (p 18)
(pattern-lit (p 9) (p 17) "hello" 'hide) 0 1
#f)))) (pattern-lit (p 9) (p 17) "hello" 'hide)
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH")))
(list (rule (p 1) (p 20) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH")))
(lhs-id (p 1) (p 5) "expr" #f) (list (rule (p 1) (p 20)
(pattern-choice (p 8) (p 20) (lhs-id (p 1) (p 5) "expr" #f)
(list (pattern-token (p 8) (p 13) "COLON" #f) (pattern-choice (p 8) (p 20)
(pattern-token (p 16) (p 20) "BLAH" #f)) (list (pattern-token (p 8) (p 13) "COLON" #f)
#f)))) (pattern-token (p 16) (p 20) "BLAH" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr")))
(list (rule (p 1) (p 31) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr")))
(lhs-id (p 1) (p 5) "expr" #f) (list
(pattern-choice (p 8) (p 31) (rule
(list (pattern-token (p 8) (p 13) "COLON" #f) (p 1) (p 31)
(pattern-token (p 16) (p 20) "BLAH" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 23) (p 31) (pattern-choice
(list (pattern-token (p 23) (p 26) "BAZ" #f) (p 8) (p 31)
(pattern-id (p 27) (p 31) "expr" #f)) (list (pattern-token (p 8) (p 13) "COLON" #f)
#f)) (pattern-token (p 16) (p 20) "BLAH" #f)
#f)))) (pattern-seq (p 23) (p 31)
(list (pattern-token (p 23) (p 26) "BAZ" #f)
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three"))) (pattern-id (p 27) (p 31) "expr" #f))
(list (rule (p 1) (p 22) #f))
(lhs-id (p 1) (p 5) "expr" #f) #f))))
(pattern-seq (p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three")))
(pattern-id (p 12) (p 15) "two" #f) (list (rule (p 1) (p 22)
(pattern-id (p 16) (p 22) "three" 'hide)) (lhs-id (p 1) (p 5) "expr" #f)
#f)))) (pattern-seq (p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f)
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)"))) (pattern-id (p 12) (p 15) "two" #f)
(list (rule (p 1) (p 23) (pattern-id (p 16) (p 22) "three" 'hide))
(lhs-id (p 1) (p 5) "expr" #f) #f))))
(pattern-seq (p 8) (p 23)
(list (pattern-id (p 9) (p 12) "one" #f) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))
(pattern-id (p 13) (p 16) "two" #f) (list (rule (p 1) (p 23)
(pattern-id (p 17) (p 22) "three" #f)) (lhs-id (p 1) (p 5) "expr" #f)
#f)))) (pattern-seq (p 8) (p 23)
(list (pattern-id (p 9) (p 12) "one" #f)
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three"))) (pattern-id (p 13) (p 16) "two" #f)
(list (rule (p 1) (p 22) (pattern-id (p 17) (p 22) "three" #f))
(lhs-id (p 1) (p 5) "expr" #f) #f))))
(pattern-seq (p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three")))
(pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f) #f) (list
(pattern-id (p 17) (p 22) "three" #f)) (rule
#f)))) (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three"))) (pattern-seq
(list (rule (p 1) (p 22) (p 8) (p 22)
(lhs-id (p 1) (p 5) "expr" #f) (list (pattern-id (p 8) (p 11) "one" #f)
(pattern-seq (p 8) (p 22) (pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f) #f)
(list (pattern-id (p 8) (p 11) "one" #f) (pattern-id (p 17) (p 22) "three" #f))
(pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f) #f) #f))))
(pattern-id (p 17) (p 22) "three" #f))
#f)))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three")))
(list
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three"))) (rule
(list (rule (p 1) (p 24) (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 24) (pattern-seq
(list (pattern-repeat (p 8) (p 18) 1 #f (p 8) (p 22)
(pattern-seq (p 8) (p 17) (list (pattern-id (p 8) (p 11) "one" #f)
(list (pattern-id (p 9) (p 12) "one" #f) (pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f) #f)
(pattern-id (p 13) (p 16) "two" #f)) (pattern-id (p 17) (p 22) "three" #f))
#f) #f))))
#f)
(pattern-id (p 19) (p 24) "three" #f)) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three")))
#f)))) (list
(rule
(p 1) (p 24)
(check-equal? (grammar-parser (tokenize (open-input-string #<<EOF (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq
(p 8) (p 24)
(list (pattern-repeat (p 8) (p 18) 1 #f
(pattern-seq (p 8) (p 17)
(list (pattern-id (p 9) (p 12) "one" #f)
(pattern-id (p 13) (p 16) "two" #f))
#f)
#f)
(pattern-id (p 19) (p 24) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string #<<EOF
statlist : stat+ statlist : stat+
stat: ID '=' expr stat: ID '=' expr
| 'print' expr | 'print' expr
EOF EOF
))) )))
(list (rule (p 1) (p 17) (list
(lhs-id (p 1) (p 9) "statlist" #f) (rule (p 1) (p 17)
(pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f) #f)) (lhs-id (p 1) (p 9) "statlist" #f)
(rule (p 18) (p 54) (pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f) #f))
(lhs-id (p 18) (p 22) "stat" #f) (rule (p 18) (p 54)
(pattern-choice (p 24) (p 54) (lhs-id (p 18) (p 22) "stat" #f)
(list (pattern-seq (p 24) (p 35) (pattern-choice (p 24) (p 54)
(list (pattern-token (p 24) (p 26) "ID" #f) (list (pattern-seq (p 24) (p 35)
(pattern-lit (p 27) (p 30) "=" #f) (list (pattern-token (p 24) (p 26) "ID" #f)
(pattern-id (p 31) (p 35) "expr" #f)) (pattern-lit (p 27) (p 30) "=" #f)
#f) (pattern-id (p 31) (p 35) "expr" #f))
(pattern-seq (p 42) (p 54) #f)
(list (pattern-lit (p 42) (p 49) "print" #f) (pattern-seq (p 42) (p 54)
(pattern-id (p 50) (p 54) "expr" #f)) (list (pattern-lit (p 42) (p 49) "print" #f)
#f)) (pattern-id (p 50) (p 54) "expr" #f))
#f)))) #f))
#f)))))

11
tests/test-quotation-marks-and-backslashes.rkt
Unescape Escape View File

@ -1,6 +1,9 @@
#lang racket/base #lang racket/base
(require yaragg/examples/quotation-marks-and-backslashes
yaragg/support
rackunit)
(check-equal? (parse-tree "a\"'\\a\"'\\") '(start "a" "\"" "'" "\\" "a" "\"" "'" "\\")) (module+ test
(require yaragg/examples/quotation-marks-and-backslashes
yaragg/support
rackunit)
(check-equal? (parse-tree "a\"'\\a\"'\\") '(start "a" "\"" "'" "\\" "a" "\"" "'" "\\")))

145
tests/test-simple-arithmetic-grammar.rkt
Unescape Escape View File

@ -1,72 +1,75 @@
#lang racket/base #lang racket/base
(require yaragg/examples/simple-arithmetic-grammar
yaragg/support (module+ test
racket/set
yaragg/parser-tools/lex (require yaragg/examples/simple-arithmetic-grammar
racket/list yaragg/support
rackunit) racket/set
yaragg/parser-tools/lex
(define (tokenize ip) racket/list
(port-count-lines! ip) rackunit)
(define lex/1
(lexer-src-pos (define (tokenize ip)
[(repetition 1 +inf.0 numeric) (port-count-lines! ip)
(token 'INT (string->number lexeme))] (define lex/1
[whitespace (lexer-src-pos
(token 'WHITESPACE #:skip? #t)] [(repetition 1 +inf.0 numeric)
["+" (token 'INT (string->number lexeme))]
(token '+ "+")] [whitespace
["*" (token 'WHITESPACE #:skip? #t)]
(token '* "*")] ["+"
[(eof) (token '+ "+")]
(token eof)])) ["*"
(lambda () (token '* "*")]
(lex/1 ip))) [(eof)
(token eof)]))
(lambda ()
;; expr : term ('+' term)* (lex/1 ip)))
;; term : factor (('*') factor)*
;; factor : INT
;; expr : term ('+' term)*
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42")))) ;; term : factor (('*') factor)*
'(expr (term (factor 42)))) ;; factor : INT
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4"))))
'(expr (term (factor 3)) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42"))))
"+" '(expr (term (factor 42))))
(term (factor 4)))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4"))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4+5")))) '(expr (term (factor 3))
'(expr (term (factor 3)) "+"
"+" (term (factor 4))))
(term (factor 4)) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4+5"))))
"+" '(expr (term (factor 3))
(term (factor 5)))) "+"
(term (factor 4))
"+"
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4*5")))) (term (factor 5))))
'(expr (term (factor 3) "*" (factor 4) "*" (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4*5"))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6")))) '(expr (term (factor 3) "*" (factor 4) "*" (factor 5))))
'(expr (term (factor 3) "*" (factor 4))
"+"
(term (factor 5) "*" (factor 6)))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6"))))
'(expr (term (factor 3) "*" (factor 4))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6")))) "+"
'(expr (term (factor 4) "*" (factor 5)) (term (factor 5) "*" (factor 6))))
"+"
(term (factor 6)))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6"))))
'(expr (term (factor 4) "*" (factor 5))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6")))) "+"
'(expr (term (factor 4)) (term (factor 6))))
"+"
(term (factor 5) "*" (factor 6)))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6"))))
'(expr (term (factor 4))
"+"
(check-exn exn:fail:parsing? (term (factor 5) "*" (factor 6))))
(lambda () (parse #f (tokenize (open-input-string "7+")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+6+"))))) (check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+")))))
(check-exn exn:fail:parsing?
(check-equal? all-token-types (lambda () (parse #f (tokenize (open-input-string "7+6+")))))
(set '+ '* 'INT))
(check-equal? all-token-types
(set '+ '* 'INT)))

98
tests/test-simple-line-drawing.rkt
Unescape Escape View File

@ -1,69 +1,71 @@
#lang racket/base #lang racket/base
(require yaragg/examples/simple-line-drawing (module+ test
yaragg/support
racket/list
yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
rackunit)
(define (make-tokenizer ip) (require yaragg/examples/simple-line-drawing
(port-count-lines! ip) yaragg/support
(define lex (lexer-src-pos racket/list
[(:+ numeric) yaragg/parser-tools/lex
(token 'INTEGER (string->number lexeme))] (prefix-in : yaragg/parser-tools/lex-sre)
[upper-case rackunit)
(token 'STRING lexeme)]
["b"
(token 'STRING " ")]
[";"
(token ";" lexeme)]
[whitespace
(token 'WHITESPACE lexeme #:skip? #t)]
[(eof)
(void)]))
(lambda ()
(lex ip)))
(define (make-tokenizer ip)
(port-count-lines! ip)
(define lex (lexer-src-pos
[(:+ numeric)
(token 'INTEGER (string->number lexeme))]
[upper-case
(token 'STRING lexeme)]
["b"
(token 'STRING " ")]
[";"
(token ";" lexeme)]
[whitespace
(token 'WHITESPACE lexeme #:skip? #t)]
[(eof)
(void)]))
(lambda ()
(lex ip)))
(define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF (define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF
3 9 X; 3 9 X;
6 3 b 3 X 3 b; 6 3 b 3 X 3 b;
3 9 X; 3 9 X;
EOF EOF
)))) ))))
(check-true (syntax-original? the-parsed-object-stx)) (check-true (syntax-original? the-parsed-object-stx))
;; Does the rule name "drawing" also have the proper "original?" property set? ;; Does the rule name "drawing" also have the proper "original?" property set?
(check-true (syntax-original? (first (syntax->list the-parsed-object-stx)))) (check-true (syntax-original? (first (syntax->list the-parsed-object-stx))))
(check-equal? (syntax->datum the-parsed-object-stx) (check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";") '(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";") (rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(rows (repeat 3) (chunk 9 "X") ";"))) (rows (repeat 3) (chunk 9 "X") ";")))
(define the-parsed-object (syntax->list the-parsed-object-stx)) (define the-parsed-object (syntax->list the-parsed-object-stx))
(check-equal? (syntax-line the-parsed-object-stx) 1) (check-equal? (syntax-line the-parsed-object-stx) 1)
(check-equal? (syntax-column the-parsed-object-stx) 0) (check-equal? (syntax-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1) (check-equal? (syntax-position the-parsed-object-stx) 1)
(check-equal? (syntax-span the-parsed-object-stx) 28) (check-equal? (syntax-span the-parsed-object-stx) 28)
(check-equal? (length the-parsed-object) 4) (check-equal? (length the-parsed-object) 4)
(check-equal? (syntax->datum (second the-parsed-object)) (check-equal? (syntax->datum (second the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";")) '(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1) (check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (third the-parsed-object)) (check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")) '(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2) (check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (fourth the-parsed-object)) (check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";")) '(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3) (check-equal? (syntax-line (list-ref the-parsed-object 3)) 3))
;; FIXME: add tests to make sure location is as we expect. ;; FIXME: add tests to make sure location is as we expect.
;; ;;

17
tests/test-start-and-atok.rkt
Unescape Escape View File

@ -1,14 +1,13 @@
#lang racket/base #lang racket/base
(require yaragg/examples/start-and-atok (module+ test
yaragg/support
rackunit)
;; make sure that "start" and "atok" work as terminals.
(check-equal? (parse-to-datum (list "start")) '(top "start"))
(check-equal? (parse-to-datum (list "atok")) '(top "atok"))
(check-equal? (parse-to-datum (list "start" "atok")) '(top "start" "atok"))
(require yaragg/examples/start-and-atok
yaragg/support
rackunit)
;; make sure that "start" and "atok" work as terminals.
(check-equal? (parse-to-datum (list "start")) '(top "start"))
(check-equal? (parse-to-datum (list "atok")) '(top "atok"))
(check-equal? (parse-to-datum (list "start" "atok")) '(top "start" "atok")))

18
tests/test-top-level-cut.rkt
Unescape Escape View File

@ -1,11 +1,13 @@
#lang racket/base #lang racket/base
(require (prefix-in 1: yaragg/examples/top-level-cut-1)
(prefix-in 2: yaragg/examples/top-level-cut-2)
(prefix-in 3: yaragg/examples/top-level-cut-3)
yaragg/support
rackunit)
(check-equal? (1:parse-to-datum "x") '((sub "x"))) (module+ test
(check-equal? (2:parse-to-datum "x") '(("x")))
(check-equal? (3:parse-to-datum "x") '("x"))
(require (prefix-in 1: yaragg/examples/top-level-cut-1)
(prefix-in 2: yaragg/examples/top-level-cut-2)
(prefix-in 3: yaragg/examples/top-level-cut-3)
yaragg/support
rackunit)
(check-equal? (1:parse-to-datum "x") '((sub "x")))
(check-equal? (2:parse-to-datum "x") '(("x")))
(check-equal? (3:parse-to-datum "x") '("x")))

10
tests/test-weird-grammar.rkt
Unescape Escape View File

@ -1,7 +1,9 @@
#lang racket/base #lang racket/base
(require yaragg/tests/weird-grammar (module+ test
rackunit)
(check-equal? (syntax->datum (parse '("foo"))) (require yaragg/tests/weird-grammar
'(foo "foo")) rackunit)
(check-equal? (syntax->datum (parse '("foo")))
'(foo "foo")))

27
tests/test-whitespace.rkt
Unescape Escape View File

@ -1,16 +1,19 @@
#lang racket/base #lang racket/base
(require yaragg/examples/whitespace
yaragg/support
rackunit)
(check-equal? (module+ test
(parse-to-datum "\ty\n x\tz\r")
'(start (tab "\t") (letter "y") (newline "\n") (space " ") (letter "x") (tab "\t") (letter "z") (return "\r")))
(check-equal? (require yaragg/examples/whitespace
(parse-to-datum "\t\n \t\r") yaragg/support
'(start (tab "\t") (newline "\n") (space " ") (tab "\t") (return "\r"))) rackunit)
(check-equal? (check-equal?
(parse-to-datum "\a\b\t\n\v\f\r\e") (parse-to-datum "\ty\n x\tz\r")
'(start (all "\a" "\b" "\t" "\n" "\v" "\f" "\r" "\e"))) '(start (tab "\t") (letter "y") (newline "\n") (space " ") (letter "x") (tab "\t") (letter "z") (return "\r")))
(check-equal?
(parse-to-datum "\t\n \t\r")
'(start (tab "\t") (newline "\n") (space " ") (tab "\t") (return "\r")))
(check-equal?
(parse-to-datum "\a\b\t\n\v\f\r\e")
'(start (all "\a" "\b" "\t" "\n" "\v" "\f" "\r" "\e"))))

24
tests/test-wordy.rkt
Unescape Escape View File

@ -1,18 +1,20 @@
#lang racket/base #lang racket/base
(require yaragg/examples/wordy
yaragg/support
rackunit)
(check-equal? (module+ test
(syntax->datum
(parse (list "hello" "world")))
'(sentence (verb (greeting "hello")) (optional-adjective) (object "world")))
(require yaragg/examples/wordy
yaragg/support
rackunit)
(check-equal?
(syntax->datum
(parse (list "hello" "world")))
'(sentence (verb (greeting "hello")) (optional-adjective) (object "world")))
(check-equal?
(syntax->datum
(parse (list "hola" "frumpy" (token 'WORLD "세계"))))
'(sentence (verb (greeting "hola")) (optional-adjective "frumpy") (object "세계")))
(check-equal?
(syntax->datum
(parse (list "hola" "frumpy" (token 'WORLD "세계"))))
'(sentence (verb (greeting "hola")) (optional-adjective "frumpy") (object "세계"))))

Write Preview
Loading…
Cancel
Save