Use test submodules for yaragg lang tests

remotes/jackfirth/master
Jack Firth 2 years ago
parent 5a90bb6551
commit e7415fc690

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

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

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

@ -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))

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

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

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

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

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

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

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

@ -1,15 +1,17 @@
#lang racket/base #lang racket/base
(require rackunit (module+ test
(require rackunit
(for-syntax racket/base)) (for-syntax racket/base))
;; The tests in this module make sure we produce proper error messages ;; The tests in this module make sure we produce proper error messages
;; on weird grammars. ;; on weird grammars.
(define-namespace-anchor anchor) (define-namespace-anchor anchor)
(define ns (namespace-anchor->namespace anchor)) (define ns (namespace-anchor->namespace anchor))
(define (c prog) (define (c prog)
(parameterize ([current-namespace ns] (parameterize ([current-namespace ns]
[read-accept-reader #t]) [read-accept-reader #t])
(define ip (open-input-string prog)) (define ip (open-input-string prog))
@ -17,8 +19,8 @@
(compile (read-syntax #f ip)))) (compile (read-syntax #f ip))))
;; Helper to let me quickly write compile-error checks. ;; Helper to let me quickly write compile-error checks.
(define-syntax (check-compile-error stx) (define-syntax (check-compile-error stx)
(syntax-case stx () (syntax-case stx ()
[(_ prog expected-msg) [(_ prog expected-msg)
(quasisyntax/loc stx (quasisyntax/loc stx
@ -35,50 +37,50 @@
;; errors with position are sensitive to length of lang line ;; errors with position are sensitive to length of lang line
(define lang-line "#lang yaragg") (define lang-line "#lang yaragg")
(check-compile-error (format "~a" lang-line) (check-compile-error (format "~a" lang-line)
"The grammar does not appear to have any rules") "The grammar does not appear to have any rules")
(check-compile-error (format "~a\nfoo" lang-line) (check-compile-error (format "~a\nfoo" lang-line)
"Error while parsing grammar near: foo [line=2, column=0, position=14]") "Error while parsing grammar near: foo [line=2, column=0, position=14]")
(check-compile-error (format "~a\nnumber : 42" lang-line) (check-compile-error (format "~a\nnumber : 42" lang-line)
"Error while parsing grammar near: 42 [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) (check-compile-error (format "~a\nnumber : 1" lang-line)
"Error while parsing grammar near: 1 [line=2, column=9, position=23]") "Error while parsing grammar near: 1 [line=2, column=9, position=23]")
(check-compile-error "#lang yaragg\n x: NUMBER\nx:STRING" (check-compile-error "#lang yaragg\n x: NUMBER\nx:STRING"
"Rule x has a duplicate definition") "Rule x has a duplicate definition")
;; Check to see that missing definitions for rules also raise good syntax ;; Check to see that missing definitions for rules also raise good syntax
;; errors: ;; errors:
(check-compile-error "#lang yaragg\nx:y" (check-compile-error "#lang yaragg\nx:y"
"Rule y has no definition") "Rule y has no definition")
(check-compile-error "#lang yaragg\nnumber : 1flarbl" (check-compile-error "#lang yaragg\nnumber : 1flarbl"
"Rule 1flarbl has no definition") "Rule 1flarbl has no definition")
(check-compile-error "#lang yaragg\nprogram: EOF" (check-compile-error "#lang yaragg\nprogram: EOF"
"Token EOF is reserved and can not be used in a grammar") "Token EOF is reserved and can not be used in a grammar")
;; Nontermination checks: ;; Nontermination checks:
(check-compile-error "#lang yaragg\nx : x" (check-compile-error "#lang yaragg\nx : x"
"Rule x has no finite derivation") "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"
@ -88,8 +90,8 @@ EOF
; 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
@ -99,7 +101,7 @@ EOF
(check-compile-error #<<EOF (check-compile-error #<<EOF
#lang yaragg #lang yaragg
a : [b] a : [b]
b : [c] b : [c]
@ -108,7 +110,7 @@ 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
@ -117,7 +119,7 @@ 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]
@ -128,10 +130,10 @@ EOF
(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"
) ))

@ -1,68 +1,71 @@
#lang racket/base #lang racket/base
(require yaragg/rules/stx-types
(module+ test
(require yaragg/rules/stx-types
yaragg/codegen/flatten yaragg/codegen/flatten
rackunit) rackunit)
(define (make-fresh-name) (define (make-fresh-name)
(let ([n 0]) (let ([n 0])
(lambda () (lambda ()
(set! n (add1 n)) (set! n (add1 n))
(string->symbol (format "r~a" n))))) (string->symbol (format "r~a" n)))))
;; Simple literals ;; Simple literals
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (lit "hello")))) (check-equal? (map syntax->datum (flatten-rule #'(rule expr (lit "hello"))))
'((prim-rule lit expr [(lit "hello")]))) '((prim-rule lit expr [(lit "hello")])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (flatten-rule #'(rule expr
(seq (lit "hello") (seq (lit "hello")
(lit "world"))))) (lit "world")))))
'((prim-rule seq expr [(lit "hello") (lit "world")]))) '((prim-rule seq expr [(lit "hello") (lit "world")])))
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (token HELLO)))) (check-equal? (map syntax->datum (flatten-rule #'(rule expr (token HELLO))))
'((prim-rule token expr [(token HELLO)]))) '((prim-rule token expr [(token HELLO)])))
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (id rule-2)))) (check-equal? (map syntax->datum (flatten-rule #'(rule expr (id rule-2))))
'((prim-rule id expr [(id rule-2)]))) '((prim-rule id expr [(id rule-2)])))
;; Sequences of primitives ;; Sequences of primitives
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (lit "1") (seq (lit "2") (lit "3")))))) (flatten-rule #'(rule expr (seq (lit "1") (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr '((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")]))) [(lit "1") (lit "2") (lit "3")])))
(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 (seq (seq (lit "1") (lit "2")) (lit "3")))))
'((prim-rule seq expr '((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")]))) [(lit "1") (lit "2") (lit "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 expr (seq (seq (lit "1")) (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr '((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")]))) [(lit "1") (lit "2") (lit "3")])))
;; choices ;; choices
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (choice (id rule-2) (id rule-3))))) (flatten-rule #'(rule expr (choice (id rule-2) (id rule-3)))))
'((prim-rule choice expr '((prim-rule choice expr
[(id rule-2)] [(id rule-2)]
[(id rule-3)]))) [(id rule-3)])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")")) (flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")"))
(seq))) (seq)))
#:fresh-name (make-fresh-name))) #:fresh-name (make-fresh-name)))
'((prim-rule choice sexp '((prim-rule choice sexp
[(lit "(") (lit ")")] []))) [(lit "(") (lit ")")] [])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH)) (flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH))
(lit ")")) (lit ")"))
(seq))) (seq)))
@ -73,18 +76,18 @@
;; maybe ;; maybe
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (id rule-2))))) (flatten-rule #'(rule expr (maybe (id rule-2)))))
'((prim-rule maybe expr '((prim-rule maybe expr
[(id rule-2)] [(id rule-2)]
[]))) [])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (token HUH))))) (flatten-rule #'(rule expr (maybe (token HUH)))))
'((prim-rule maybe expr '((prim-rule maybe expr
[(token HUH)] [(token HUH)]
[]))) [])))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world")))))) (flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
'((prim-rule maybe expr '((prim-rule maybe expr
[(lit "hello") (lit "world")] [(lit "hello") (lit "world")]
@ -93,26 +96,26 @@
;; repeat ;; repeat
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2))))) (flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ()) '((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
(inferred-prim-rule repeat %rule1 (inferred-prim-rule repeat %rule1
((inferred-id %rule1 repeat) (id rule-2)) ((inferred-id %rule1 repeat) (id rule-2))
((id rule-2))))) ((id rule-2)))))
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2)))))) (flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2))))))
'((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ()) '((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
(inferred-prim-rule repeat %rule2 (inferred-prim-rule repeat %rule2
((inferred-id %rule2 repeat) (lit "+") (id rule-2)) ((inferred-id %rule2 repeat) (lit "+") (id rule-2))
((lit "+") (id rule-2))))) ((lit "+") (id rule-2)))))
(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 1 #f (id rule-2)))))
'((prim-rule repeat rule-2+ '((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (id rule-2)] [(inferred-id rule-2+ repeat) (id rule-2)]
[(id rule-2)]))) [(id rule-2)])))
(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 rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2))))))
'((prim-rule repeat rule-2+ '((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (lit "-") (id rule-2)] [(inferred-id rule-2+ repeat) (lit "-") (id rule-2)]
@ -123,10 +126,10 @@
;; Mixtures ;; Mixtures
;; choice and maybe ;; choice and maybe
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x") (flatten-rule #'(rule sexp (choice (lit "x")
(maybe (lit "y")))) (maybe (lit "y"))))
#:fresh-name (make-fresh-name))) #:fresh-name (make-fresh-name)))
@ -136,8 +139,8 @@
(inferred-prim-rule maybe r1 (inferred-prim-rule maybe r1
[(lit "y")] [(lit "y")]
[]))) [])))
;; choice, maybe, repeat ;; choice, maybe, repeat
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x") (flatten-rule #'(rule sexp (choice (lit "x")
(maybe (repeat 1 #f (lit "y"))))) (maybe (repeat 1 #f (lit "y")))))
#:fresh-name (make-fresh-name))) #:fresh-name (make-fresh-name)))
@ -150,8 +153,8 @@
(inferred-prim-rule repeat r2 (inferred-prim-rule repeat r2
[(inferred-id r2 repeat) (lit "y")] [(inferred-id r2 repeat) (lit "y")]
[(lit "y")]))) [(lit "y")])))
;; choice, seq ;; choice, seq
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y")) (flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w")))) (seq (lit "z") (lit "w"))))
#:fresh-name (make-fresh-name))) #:fresh-name (make-fresh-name)))
@ -159,8 +162,8 @@
[(lit "x") (lit "y")] [(lit "x") (lit "y")]
[(lit "z") (lit "w")]))) [(lit "z") (lit "w")])))
;; maybe, choice ;; maybe, choice
(check-equal? (map syntax->datum (check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y")) (flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w"))))) (seq (lit "z") (lit "w")))))
#:fresh-name (make-fresh-name))) #:fresh-name (make-fresh-name)))
@ -172,24 +175,23 @@
[(lit "z") (lit "w")]))) [(lit "z") (lit "w")])))
;; seq, repeat (test-case "seq, repeat"
(check-equal? (map syntax->datum (define rule-stx #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))))
(flatten-rule #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))) (check-equal? (map syntax->datum (flatten-rule rule-stx #:fresh-name (make-fresh-name)))
#:fresh-name (make-fresh-name)))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat))) '((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ()) (prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2 (inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term)) ((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term))))) ((lit "+") (id term))))))
;; larger example: simple arithmetic (test-case "larger example: simple arithmetic"
(check-equal? (map syntax->datum (define rule-stxs
(flatten-rules (syntax->list (syntax->list
#'((rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))) #'((rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
(rule term (seq (id factor) (repeat 0 #f (seq (lit "*") (id factor))))) (rule term (seq (id factor) (repeat 0 #f (seq (lit "*") (id factor)))))
(rule factor (token INT)))) (rule factor (token INT)))))
#:fresh-name (make-fresh-name))) (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 seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ()) (prim-rule maybe r1 ((inferred-id r2 repeat)) ())
@ -201,4 +203,4 @@
(inferred-prim-rule repeat r4 (inferred-prim-rule repeat r4
((inferred-id r4 repeat) (lit "*") (id factor)) ((inferred-id r4 repeat) (lit "*") (id factor))
((lit "*") (id factor))) ((lit "*") (id factor)))
(prim-rule token factor ((token INT))))) (prim-rule token factor ((token INT)))))))

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

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

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

@ -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")))

@ -2,16 +2,18 @@
;; 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
(require yaragg/examples/simple-line-drawing
yaragg/support yaragg/support
racket/list racket/list
yaragg/parser-tools/lex yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre) (prefix-in : yaragg/parser-tools/lex-sre)
rackunit) rackunit)
(define-tokens tokens (INTEGER STRING |;| EOF)) (define-tokens tokens (INTEGER STRING |;| EOF))
(define (make-tokenizer ip) (define (make-tokenizer ip)
(port-count-lines! ip) (port-count-lines! ip)
(define lex (lexer-src-pos (define lex (lexer-src-pos
[(:+ numeric) [(:+ numeric)
@ -31,43 +33,43 @@
(define the-parsed-object-stx (define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF (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.
;; ;;

@ -1,41 +1,42 @@
#lang racket/base #lang racket/base
(module+ test
(require rackunit (require rackunit
yaragg/parser-tools/lex yaragg/parser-tools/lex
yaragg/rules/parser yaragg/rules/parser
yaragg/rules/lexer yaragg/rules/lexer
yaragg/rules/rule-structs) yaragg/rules/rule-structs)
;; quick-and-dirty helper for pos construction. ;; quick-and-dirty helper for pos construction.
(define (p x) (define (p x)
(pos x #f #f)) (pos x #f #f))
;; FIXME: fix the test cases so they work on locations rather than just offsets. ;; FIXME: fix the test cases so they work on locations rather than just offsets.
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'")))
(list (rule (p 1) (p 15) (list (rule (p 1) (p 15)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-lit (p 8) (p 15) "hello" #f)))) (pattern-lit (p 8) (p 15) "hello" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON")))
(list (rule (p 1) (p 13) (list (rule (p 1) (p 13)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-token (p 8) (p 13) "COLON" #f)))) (pattern-token (p 8) (p 13) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "/expr : COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "/expr : COLON")))
(list (rule (p 1) (p 14) (list (rule (p 1) (p 14)
(lhs-id (p 1) (p 6) "expr" ''hide) (lhs-id (p 1) (p 6) "expr" ''hide)
(pattern-token (p 9) (p 14) "COLON" #f)))) (pattern-token (p 9) (p 14) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "@expr : COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "@expr : COLON")))
(list (rule (p 1) (p 14) (list (rule (p 1) (p 14)
(lhs-id (p 1) (p 6) "expr" ''splice) (lhs-id (p 1) (p 6) "expr" ''splice)
(pattern-token (p 9) (p 14) "COLON" #f)))) (pattern-token (p 9) (p 14) "COLON" #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : /COLON COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /COLON COLON")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
@ -44,7 +45,7 @@
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-token (p 15) (p 20) "COLON" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : /thing COLON")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
@ -53,7 +54,7 @@
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-token (p 15) (p 20) "COLON" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : @thing COLON")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20) (pattern-seq (p 8) (p 20)
@ -62,7 +63,7 @@
(pattern-token (p 15) (p 20) "COLON" #f)) (pattern-token (p 15) (p 20) "COLON" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'*")))
(list (rule (p 1) (p 16) (list (rule (p 1) (p 16)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16) (pattern-repeat (p 8) (p 16)
@ -70,7 +71,7 @@
(pattern-lit (p 8) (p 15) "hello" #f) (pattern-lit (p 8) (p 15) "hello" #f)
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : 'hello'+")))
(list (rule (p 1) (p 16) (list (rule (p 1) (p 16)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16) (pattern-repeat (p 8) (p 16)
@ -78,7 +79,7 @@
(pattern-lit (p 8) (p 15) "hello" #f) (pattern-lit (p 8) (p 15) "hello" #f)
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : [/'hello']")))
(list (rule (p 1) (p 18) (list (rule (p 1) (p 18)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
#;(pattern-maybe (p 8) (p 18) #;(pattern-maybe (p 8) (p 18)
@ -88,7 +89,7 @@
(pattern-lit (p 9) (p 17) "hello" 'hide) (pattern-lit (p 9) (p 17) "hello" 'hide)
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH")))
(list (rule (p 1) (p 20) (list (rule (p 1) (p 20)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 20) (pattern-choice (p 8) (p 20)
@ -96,10 +97,13 @@
(pattern-token (p 16) (p 20) "BLAH" #f)) (pattern-token (p 16) (p 20) "BLAH" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH | BAZ expr")))
(list (rule (p 1) (p 31) (list
(rule
(p 1) (p 31)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 31) (pattern-choice
(p 8) (p 31)
(list (pattern-token (p 8) (p 13) "COLON" #f) (list (pattern-token (p 8) (p 13) "COLON" #f)
(pattern-token (p 16) (p 20) "BLAH" #f) (pattern-token (p 16) (p 20) "BLAH" #f)
(pattern-seq (p 23) (p 31) (pattern-seq (p 23) (p 31)
@ -108,7 +112,7 @@
#f)) #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three")))
(list (rule (p 1) (p 22) (list (rule (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 22) (pattern-seq (p 8) (p 22)
@ -117,7 +121,7 @@
(pattern-id (p 16) (p 22) "three" 'hide)) (pattern-id (p 16) (p 22) "three" 'hide))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))
(list (rule (p 1) (p 23) (list (rule (p 1) (p 23)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 23) (pattern-seq (p 8) (p 23)
@ -126,28 +130,37 @@
(pattern-id (p 17) (p 22) "three" #f)) (pattern-id (p 17) (p 22) "three" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three")))
(list (rule (p 1) (p 22) (list
(rule
(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 22) (pattern-seq
(p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f) (list (pattern-id (p 8) (p 11) "one" #f)
(pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f) #f) (pattern-repeat (p 12) (p 16) 0 #f (pattern-id (p 12) (p 15) "two" #f) #f)
(pattern-id (p 17) (p 22) "three" #f)) (pattern-id (p 17) (p 22) "three" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three")))
(list (rule (p 1) (p 22) (list
(rule
(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 22) (pattern-seq
(p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f) (list (pattern-id (p 8) (p 11) "one" #f)
(pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f) #f) (pattern-repeat (p 12) (p 16) 1 #f (pattern-id (p 12) (p 15) "two" #f) #f)
(pattern-id (p 17) (p 22) "three" #f)) (pattern-id (p 17) (p 22) "three" #f))
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three"))) (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three")))
(list (rule (p 1) (p 24) (list
(rule
(p 1) (p 24)
(lhs-id (p 1) (p 5) "expr" #f) (lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 24) (pattern-seq
(p 8) (p 24)
(list (pattern-repeat (p 8) (p 18) 1 #f (list (pattern-repeat (p 8) (p 18) 1 #f
(pattern-seq (p 8) (p 17) (pattern-seq (p 8) (p 17)
(list (pattern-id (p 9) (p 12) "one" #f) (list (pattern-id (p 9) (p 12) "one" #f)
@ -158,13 +171,14 @@
#f)))) #f))))
(check-equal? (grammar-parser (tokenize (open-input-string #<<EOF (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
(rule (p 1) (p 17)
(lhs-id (p 1) (p 9) "statlist" #f) (lhs-id (p 1) (p 9) "statlist" #f)
(pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f) #f)) (pattern-repeat (p 12) (p 17) 1 #f (pattern-id (p 12) (p 16) "stat" #f) #f))
(rule (p 18) (p 54) (rule (p 18) (p 54)
@ -179,5 +193,4 @@ EOF
(list (pattern-lit (p 42) (p 49) "print" #f) (list (pattern-lit (p 42) (p 49) "print" #f)
(pattern-id (p 50) (p 54) "expr" #f)) (pattern-id (p 50) (p 54) "expr" #f))
#f)) #f))
#f)))) #f)))))

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

@ -1,12 +1,15 @@
#lang racket/base #lang racket/base
(require yaragg/examples/simple-arithmetic-grammar
(module+ test
(require yaragg/examples/simple-arithmetic-grammar
yaragg/support yaragg/support
racket/set racket/set
yaragg/parser-tools/lex yaragg/parser-tools/lex
racket/list racket/list
rackunit) rackunit)
(define (tokenize ip) (define (tokenize ip)
(port-count-lines! ip) (port-count-lines! ip)
(define lex/1 (define lex/1
(lexer-src-pos (lexer-src-pos
@ -24,17 +27,17 @@
(lex/1 ip))) (lex/1 ip)))
;; expr : term ('+' term)* ;; expr : term ('+' term)*
;; term : factor (('*') factor)* ;; term : factor (('*') factor)*
;; factor : INT ;; factor : INT
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42")))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42"))))
'(expr (term (factor 42)))) '(expr (term (factor 42))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4")))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4"))))
'(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")))) (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))
@ -42,31 +45,31 @@
(term (factor 5)))) (term (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"))))
'(expr (term (factor 3) "*" (factor 4) "*" (factor 5)))) '(expr (term (factor 3) "*" (factor 4) "*" (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6")))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6"))))
'(expr (term (factor 3) "*" (factor 4)) '(expr (term (factor 3) "*" (factor 4))
"+" "+"
(term (factor 5) "*" (factor 6)))) (term (factor 5) "*" (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6")))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6"))))
'(expr (term (factor 4) "*" (factor 5)) '(expr (term (factor 4) "*" (factor 5))
"+" "+"
(term (factor 6)))) (term (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6")))) (check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6"))))
'(expr (term (factor 4)) '(expr (term (factor 4))
"+" "+"
(term (factor 5) "*" (factor 6)))) (term (factor 5) "*" (factor 6))))
(check-exn exn:fail:parsing? (check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+"))))) (lambda () (parse #f (tokenize (open-input-string "7+")))))
(check-exn exn:fail:parsing? (check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+6+"))))) (lambda () (parse #f (tokenize (open-input-string "7+6+")))))
(check-equal? all-token-types (check-equal? all-token-types
(set '+ '* 'INT)) (set '+ '* 'INT)))

@ -1,13 +1,15 @@
#lang racket/base #lang racket/base
(require yaragg/examples/simple-line-drawing (module+ test
(require yaragg/examples/simple-line-drawing
yaragg/support yaragg/support
racket/list racket/list
yaragg/parser-tools/lex yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre) (prefix-in : yaragg/parser-tools/lex-sre)
rackunit) rackunit)
(define (make-tokenizer ip) (define (make-tokenizer ip)
(port-count-lines! ip) (port-count-lines! ip)
(define lex (lexer-src-pos (define lex (lexer-src-pos
[(:+ numeric) [(:+ numeric)
@ -27,43 +29,43 @@
(define the-parsed-object-stx (define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF (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.
;; ;;

@ -1,14 +1,13 @@
#lang racket/base #lang racket/base
(require yaragg/examples/start-and-atok (module+ test
(require yaragg/examples/start-and-atok
yaragg/support yaragg/support
rackunit) rackunit)
;; make sure that "start" and "atok" work as terminals. ;; 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"))
(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")))

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

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

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

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

Loading…
Cancel
Save