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 2 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
(require yaragg/examples/01-equal
rackunit)
(module+ test
(check-equal? (syntax->datum (parse ""))
'(equal))
(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")))
(require yaragg/examples/01-equal
rackunit)
(check-equal? (syntax->datum (parse "1100"))
'(equal (one (equal) "1")
(zero (equal (one (equal) "1")
(zero (equal) "0"))
"0")))
(check-equal? (syntax->datum (parse ""))
'(equal))
(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"))
'(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
(require yaragg/examples/0n1
yaragg/support
rackunit)
(module+ test
(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")])))
(require yaragg/examples/0n1
yaragg/support
rackunit)
(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?
(lambda ()
(parse #f (lex (open-input-string "10")))))
(check-exn exn:fail:parsing?
(lambda ()
(parse #f (lex (open-input-string "0")))))
(check-exn exn:fail:parsing?
(lambda ()
(parse #f (lex (open-input-string "010")))))
(check-exn exn:fail:parsing?
(lambda ()
(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.
(check-exn exn:fail:parsing?
(lambda () (parse '("zero" "one" "zero"))))
(check-exn (regexp (regexp-quote
"Encountered unexpected token of type \"zero\" (value \"zero\") while parsing"))
(lambda () (parse '("zero" "one" "zero"))))
;; This should fail predictably because we're passing in tokens
;; that the parser doesn't know.
(check-exn exn:fail:parsing?
(lambda () (parse '("zero" "one" "zero"))))
(check-exn (regexp (regexp-quote
"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
(require yaragg/examples/0n1n
yaragg/support
rackunit)
(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")])))
(module+ test
(require yaragg/examples/0n1n
yaragg/support
rackunit)
;; The only rule in the grammar is:
;;
;; 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"))
(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 "0011"))))
'(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "01"))))
'(rule-0n1n "0" (rule-0n1n) "1"))
;; The only rule in the grammar is:
;;
;; 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 ""))))
'(rule-0n1n))
(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 "000111"))))
'(rule-0n1n "0" (rule-0n1n "0" (rule-0n1n "0" (rule-0n1n) "1") "1") "1"))
(check-equal? (syntax->datum (parse #f (lex (open-input-string "01"))))
'(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?
(lambda () (parse #f (lex (open-input-string "10001110")))))
(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?
(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
(require yaragg/examples/baby-json-hider
yaragg/support
rackunit)
(define parse-result (parse (list "{"
(token 'ID "message")
":"
(token 'STRING "'hello world'")
"}")))
(check-equal? (syntax->datum parse-result) '(json (":")))
(module+ test
(define syntaxed-colon-parens (cadr (syntax->list parse-result)))
(check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'kvpair)) 'kvpair)
(require yaragg/examples/baby-json-hider
yaragg/support
rackunit)
(check-equal?
(syntax->datum
(parse "[[[{}]],[],[[{}]]]"))
'(json
(array
"["
(json (array "[" (json (array "[" (json) "]")) "]"))
","
(json (array "[" "]"))
","
(json (array "[" (json (array "[" (json) "]")) "]"))
"]")))
(define parse-result (parse (list "{"
(token 'ID "message")
":"
(token 'STRING "'hello world'")
"}")))
(check-equal? (syntax->datum parse-result) '(json (":")))
(define syntaxed-colon-parens (cadr (syntax->list parse-result)))
(check-equal? (syntax->datum (syntax-property syntaxed-colon-parens 'kvpair)) 'kvpair)
(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
(require yaragg/examples/baby-json
(prefix-in alt: yaragg/examples/baby-json-alt)
yaragg/support
rackunit)
(let ([str (list "{"
(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))
(module+ test
(require yaragg/examples/baby-json
(prefix-in alt: yaragg/examples/baby-json-alt)
yaragg/support
rackunit)
(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))
(let ([str (list "{"
(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))
(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
(require yaragg/examples/codepoints
rackunit)
(module+ test
(check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\\"\\ef\"" "hello world"))
'(start (A "\"A\\")
(c "'c\\")
(def "*d\\\"\\ef\"")
(hello-world "hello world")))
(require yaragg/examples/codepoints
rackunit)
(check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\\"\\ef\"" "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
(require yaragg/examples/curly-quantifier
yaragg/support
rackunit)
(check-exn exn:fail:parsing? (λ () (parse-to-datum "a")))
(check-equal? (parse-to-datum "aa") '(start (a-rule "a" "a")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "aaa")))
(check-equal? (parse-to-datum "") '(start (b-rule)))
(check-equal? (parse-to-datum "b") '(start (b-rule "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 "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 "cccc") '(start (c-rule "c" "c" "c" "c")))
(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 "ddd") '(start (d-rule "d" "d" "d")))
(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
(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")))
(module+ test
(require yaragg/examples/curly-quantifier
yaragg/support
rackunit)
(check-exn exn:fail:parsing? (λ () (parse-to-datum "a")))
(check-equal? (parse-to-datum "aa") '(start (a-rule "a" "a")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "aaa")))
(check-equal? (parse-to-datum "") '(start (b-rule)))
(check-equal? (parse-to-datum "b") '(start (b-rule "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 "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 "cccc") '(start (c-rule "c" "c" "c" "c")))
(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 "ddd") '(start (d-rule "d" "d" "d")))
(check-exn exn:fail:parsing? (λ () (parse-to-datum "dddd")))
; 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
(require yaragg/examples/cutter-another
yaragg/support
rackunit)
(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)))
(module+ test
(require yaragg/examples/cutter-another
yaragg/support
rackunit)
(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
(require yaragg/examples/cutter
yaragg/support
rackunit)
;; related to rule-flattening problem
(check-equal?
(parse-to-datum (list "(" "x" "," "x" ")"))
'(top (expr (list "(" (expr "x") "," (expr "x") ")"))))
(module+ test
(require yaragg/examples/cutter
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
(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
(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 "xxx") '(top (xs "x" (xs "x" (xs "x" (xs))))))
(require yaragg/examples/empty-symbol
yaragg/support
rackunit)
;; 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")))
(check-true (and (member (parse-to-datum "") (list '(top (xs)) '(top (ys)) '(top (zs)))) #t))
;; 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")))
;; x is normal
(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 "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
(require rackunit
(for-syntax racket/base))
(module+ test
;; The tests in this module make sure we produce proper error messages
;; on weird grammars.
(require rackunit
(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")
;; errors with position are sensitive to length of lang line
(define lang-line "#lang yaragg")
(check-compile-error (format "~a" lang-line)
"The grammar does not appear to have any rules")
(check-compile-error (format "~a" lang-line)
"The grammar does not appear to have any rules")
(check-compile-error (format "~a\nfoo" lang-line)
"Error while parsing grammar near: foo [line=2, column=0, position=14]")
(check-compile-error (format "~a\nfoo" lang-line)
"Error while parsing grammar near: foo [line=2, column=0, position=14]")
(check-compile-error (format "~a\nnumber : 42" lang-line)
"Error while parsing grammar near: 42 [line=2, column=9, position=23]")
(check-compile-error (format "~a\nnumber : 42" lang-line)
"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 (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-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
;; errors:
;; Check to see that missing definitions for rules also raise good syntax
;; errors:
(check-compile-error "#lang yaragg\nx:y"
"Rule y has no definition")
(check-compile-error "#lang yaragg\nx:y"
"Rule y has no definition")
(check-compile-error "#lang yaragg\nnumber : 1flarbl"
"Rule 1flarbl 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
x : x y
y : "y"
EOF
"Rule x has no finite derivation")
"Rule x has no finite derivation")
; This should be illegal too:
(check-compile-error #<<EOF
; This should be illegal too:
(check-compile-error #<<EOF
#lang yaragg
a : "a" b
b : a | b
EOF
"Rule a has no finite derivation")
"Rule a has no finite derivation")
(check-compile-error #<<EOF
(check-compile-error #<<EOF
#lang yaragg
a : [b]
b : [c]
c : c
EOF
"Rule c has no finite derivation")
"Rule c has no finite derivation")
(check-compile-error #<<EOF
(check-compile-error #<<EOF
#lang yaragg
a : [b]
b : c
c : c
EOF
"Rule b has no finite derivation")
"Rule b has no finite derivation")
(check-compile-error #<<EOF
(check-compile-error #<<EOF
#lang yaragg
a : [a]
b : [b]
c : c
EOF
"Rule c has no finite derivation")
"Rule c has no finite derivation")
(check-compile-error #<<EOF
(check-compile-error #<<EOF
#lang racket/base
(require yaragg/examples/simple-line-drawing)
(define bad-parser (make-rule-parser crunchy))
EOF
"Rule crunchy is not defined in the grammar"
)
"Rule crunchy is not defined in the grammar"
))

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

@ -1,204 +1,206 @@
#lang racket/base
(require yaragg/rules/stx-types
yaragg/codegen/flatten
rackunit)
(module+ test
(define (make-fresh-name)
(let ([n 0])
(lambda ()
(set! n (add1 n))
(string->symbol (format "r~a" n)))))
(require yaragg/rules/stx-types
yaragg/codegen/flatten
rackunit)
;; Simple literals
(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")])))
(define (make-fresh-name)
(let ([n 0])
(lambda ()
(set! n (add1 n))
(string->symbol (format "r~a" n)))))
(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))))
'((prim-rule id expr [(id rule-2)])))
;; Simple literals
(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
(flatten-rule #'(rule expr (seq (seq (lit "1") (lit "2")) (lit "3")))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (seq (lit "1")) (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
;; choices
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (choice (id rule-2) (id rule-3)))))
'((prim-rule choice expr
[(id rule-2)]
[(id rule-3)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (lit ")")] [])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH))
(lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (token BLAH) (lit ")")] [])))
;; maybe
(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
(flatten-rule #'(rule expr (maybe (token HUH)))))
'((prim-rule maybe expr
[(token HUH)]
[])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
'((prim-rule maybe expr
[(lit "hello") (lit "world")]
[])))
;; repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
(inferred-prim-rule repeat %rule1
((inferred-id %rule1 repeat) (id rule-2))
((id rule-2)))))
(check-equal? (map syntax->datum
(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)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (id rule-2)]
[(id rule-2)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2))))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (lit "-") (id rule-2)]
[(lit "-") (id rule-2)])))
;; Mixtures
;; choice and maybe
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (lit "y"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(lit "y")]
[])))
;; choice, maybe, repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (repeat 1 #f (lit "y")))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(inferred-id r2 repeat)]
[])
(inferred-prim-rule repeat r2
[(inferred-id r2 repeat) (lit "y")]
[(lit "y")])))
;; choice, seq
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; maybe, choice
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w")))))
#:fresh-name (make-fresh-name)))
'((prim-rule maybe sexp
[(inferred-id r1 choice)]
[])
(inferred-prim-rule choice r1
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; seq, repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
#: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)))))
;; larger example: simple arithmetic
(check-equal? (map syntax->datum
(flatten-rules (syntax->list
#'((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 factor (token INT))))
#:fresh-name (make-fresh-name)))
(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))))
'((prim-rule id expr [(id rule-2)])))
;; 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
(flatten-rule #'(rule expr (seq (seq (lit "1") (lit "2")) (lit "3")))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (seq (lit "1")) (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
;; choices
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (choice (id rule-2) (id rule-3)))))
'((prim-rule choice expr
[(id rule-2)]
[(id rule-3)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (lit ")")] [])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH))
(lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (token BLAH) (lit ")")] [])))
;; maybe
(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
(flatten-rule #'(rule expr (maybe (token HUH)))))
'((prim-rule maybe expr
[(token HUH)]
[])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
'((prim-rule maybe expr
[(lit "hello") (lit "world")]
[])))
;; repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
(inferred-prim-rule repeat %rule1
((inferred-id %rule1 repeat) (id rule-2))
((id rule-2)))))
(check-equal? (map syntax->datum
(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)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (id rule-2)]
[(id rule-2)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2))))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (lit "-") (id rule-2)]
[(lit "-") (id rule-2)])))
;; Mixtures
;; choice and maybe
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (lit "y"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(lit "y")]
[])))
;; choice, maybe, repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (repeat 1 #f (lit "y")))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(inferred-id r2 repeat)]
[])
(inferred-prim-rule repeat r2
[(inferred-id r2 repeat) (lit "y")]
[(lit "y")])))
;; choice, seq
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; maybe, choice
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w")))))
#:fresh-name (make-fresh-name)))
'((prim-rule maybe sexp
[(inferred-id r1 choice)]
[])
(inferred-prim-rule choice r1
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
(test-case "seq, repeat"
(define rule-stx #'(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)))
'((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))))))
(test-case "larger example: simple arithmetic"
(define rule-stxs
(syntax->list
#'((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 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)))))
'((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
(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")))
(check-equal? (parse-to-datum "yyy") '(top "y" "y" "y"))
(require yaragg/examples/hide-and-splice
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
(require yaragg/rules/lexer
rackunit
yaragg/parser-tools/lex)
(define (l s)
(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))))
(module+ test
;; WARNING: the offsets are not in terms of file positions. So they
;; start counting at 1, not 0.
(check-equal? (l " hi")
'(ID "hi" 2 4))
(require yaragg/rules/lexer
rackunit
yaragg/parser-tools/lex)
(check-equal? (l " hi")
'(ID "hi" 3 5))
(define (l s)
(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")
'(ID "hi" 1 3))
;; WARNING: the offsets are not in terms of file positions. So they
;; start counting at 1, not 0.
(check-equal? (l " hi")
'(ID "hi" 2 4))
(check-equal? (l "# foobar\nhi")
'(ID "hi" 10 12))
(check-equal? (l " hi")
'(ID "hi" 3 5))
(check-equal? (l "# foobar\rhi")
'(ID "hi" 10 12))
(check-equal? (l "hi")
'(ID "hi" 1 3))
(check-equal? (l "# foobar\r\nhi")
'(ID "hi" 11 13))
(check-equal? (l "# foobar\nhi")
'(ID "hi" 10 12))
(check-equal? (l "hi:")
'(RULE_HEAD "hi:" 1 4))
(check-equal? (l "# foobar\rhi")
'(ID "hi" 10 12))
(check-equal? (l "hi :")
'(RULE_HEAD "hi :" 1 7))
(check-equal? (l "# foobar\r\nhi")
'(ID "hi" 11 13))
(check-equal? (l "|")
'(PIPE "|" 1 2))
(check-equal? (l "hi:")
'(RULE_HEAD "hi:" 1 4))
(check-equal? (l "(")
'(LPAREN "(" 1 2))
(check-equal? (l "hi :")
'(RULE_HEAD "hi :" 1 7))
(check-equal? (l "[")
'(LBRACKET "[" 1 2))
(check-equal? (l "|")
'(PIPE "|" 1 2))
(check-equal? (l ")")
'(RPAREN ")" 1 2))
(check-equal? (l "(")
'(LPAREN "(" 1 2))
(check-equal? (l "]")
'(RBRACKET "]" 1 2))
(check-equal? (l "[")
'(LBRACKET "[" 1 2))
;; 220111: lexer now converts single-quoted lexemes
;; to standard Racket-style double-quoted string literal
(check-equal? (l "'hello'")
'(LIT "\"hello\"" 1 8))
(check-equal? (l ")")
'(RPAREN ")" 1 2))
(check-equal? (l "'he\\'llo'")
'(LIT "\"he'llo\"" 1 10))
(check-equal? (l "]")
'(RBRACKET "]" 1 2))
(check-equal? (l "/")
'(HIDE "/" 1 2))
;; 220111: lexer now converts single-quoted lexemes
;; to standard Racket-style double-quoted string literal
(check-equal? (l "'hello'")
'(LIT "\"hello\"" 1 8))
(check-equal? (l " /")
'(HIDE "/" 2 3))
(check-equal? (l "'he\\'llo'")
'(LIT "\"he'llo\"" 1 10))
(check-equal? (l "@")
'(SPLICE "@" 1 2))
(check-equal? (l "/")
'(HIDE "/" 1 2))
(check-equal? (l " @")
'(SPLICE "@" 2 3))
(check-equal? (l " /")
'(HIDE "/" 2 3))
(check-equal? (l "#:prefix-out val:")
(list 'EOF eof 18 18)) ; lexer skips kwarg
(check-equal? (l "@")
'(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
(require rackunit
yaragg/support
yaragg/examples/subrule)
(define parse-next (make-rule-parser next))
(define parse-start (make-rule-parser start))
(module+ test
(check-equal? (syntax->datum (parse #f "0")) '(start (next "0")))
(check-equal? (syntax->datum (parse #f "0")) (syntax->datum (parse "0")))
(require rackunit
yaragg/support
yaragg/examples/subrule)
(check-equal? (syntax->datum (parse-start #f "0")) '(start (next "0")))
(check-equal? (syntax->datum (parse-start #f "0")) (syntax->datum (parse-start "0")))
(define parse-next (make-rule-parser next))
(define parse-start (make-rule-parser start))
(check-equal? (syntax->datum (parse-next #f "0")) '(next "0"))
(check-equal? (syntax->datum (parse-next #f "0")) (syntax->datum (parse-next "0")))
(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-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"))))

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

@ -1,9 +1,10 @@
#lang racket/base
(require yaragg/examples/nested-repeats
rackunit)
(check-equal?
(syntax->datum (parse (list "X" "Y" "X")))
'(start "X" "Y" "X"))
(module+ test
(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.
(require yaragg/examples/simple-line-drawing
yaragg/support
racket/list
yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
rackunit)
(define-tokens tokens (INTEGER STRING |;| EOF))
(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
(return-without-pos (lex input-port))]
[(eof)
(token-EOF 'eof)]))
(lambda ()
(lex ip)))
(define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF
(module+ test
(require yaragg/examples/simple-line-drawing
yaragg/support
racket/list
yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
rackunit)
(define-tokens tokens (INTEGER STRING |;| EOF))
(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
(return-without-pos (lex input-port))]
[(eof)
(token-EOF 'eof)]))
(lambda ()
(lex ip)))
(define the-parsed-object-stx
(parse (make-tokenizer (open-input-string #<<EOF
3 9 X;
6 3 b 3 X 3 b;
3 9 X;
EOF
))))
))))
(check-true (syntax-original? the-parsed-object-stx))
;; 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? the-parsed-object-stx))
;; Does the rule name "drawing" also have the proper "original?" property set?
(check-true (syntax-original? (first (syntax->list the-parsed-object-stx))))
(check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(rows (repeat 3) (chunk 9 "X") ";")))
(check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(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-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1)
(check-equal? (syntax-span the-parsed-object-stx) 28)
(check-equal? (syntax-line the-parsed-object-stx) 1)
(check-equal? (syntax-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1)
(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))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (second the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3)
(check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3))
;; 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
(require rackunit
yaragg/parser-tools/lex
yaragg/rules/parser
yaragg/rules/lexer
yaragg/rules/rule-structs)
;; quick-and-dirty helper for pos construction.
(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'")))
(list (rule (p 1) (p 15)
(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)
(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)
(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)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-token (p 8) (p 14) "COLON" 'hide)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-id (p 8) (p 14) "thing" 'hide)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-id (p 8) (p 14) "thing" 'splice)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16)
0 #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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16)
1 #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)
(lhs-id (p 1) (p 5) "expr" #f)
#;(pattern-maybe (p 8) (p 18)
(pattern-lit (p 9) (p 17) "hello" 'hide))
(pattern-repeat (p 8) (p 18)
0 1
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 20)
(list (pattern-token (p 8) (p 13) "COLON" #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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 31)
(list (pattern-token (p 8) (p 13) "COLON" #f)
(pattern-token (p 16) (p 20) "BLAH" #f)
(pattern-seq (p 23) (p 31)
(list (pattern-token (p 23) (p 26) "BAZ" #f)
(pattern-id (p 27) (p 31) "expr" #f))
#f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three")))
(list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f)
(pattern-id (p 12) (p 15) "two" #f)
(pattern-id (p 16) (p 22) "three" 'hide))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))
(list (rule (p 1) (p 23)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 23)
(list (pattern-id (p 9) (p 12) "one" #f)
(pattern-id (p 13) (p 16) "two" #f)
(pattern-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three")))
(list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22)
(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-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three")))
(list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22)
(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-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three")))
(list (rule (p 1) (p 24)
(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
(module+ test
(require rackunit
yaragg/parser-tools/lex
yaragg/rules/parser
yaragg/rules/lexer
yaragg/rules/rule-structs)
;; quick-and-dirty helper for pos construction.
(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'")))
(list (rule (p 1) (p 15)
(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)
(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)
(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)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-token (p 8) (p 14) "COLON" 'hide)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-id (p 8) (p 14) "thing" 'hide)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 20)
(list
(pattern-id (p 8) (p 14) "thing" 'splice)
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16)
0 #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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-repeat (p 8) (p 16)
1 #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)
(lhs-id (p 1) (p 5) "expr" #f)
#;(pattern-maybe (p 8) (p 18)
(pattern-lit (p 9) (p 17) "hello" 'hide))
(pattern-repeat (p 8) (p 18)
0 1
(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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice (p 8) (p 20)
(list (pattern-token (p 8) (p 13) "COLON" #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)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-choice
(p 8) (p 31)
(list (pattern-token (p 8) (p 13) "COLON" #f)
(pattern-token (p 16) (p 20) "BLAH" #f)
(pattern-seq (p 23) (p 31)
(list (pattern-token (p 23) (p 26) "BAZ" #f)
(pattern-id (p 27) (p 31) "expr" #f))
#f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two /three")))
(list (rule (p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 22)
(list (pattern-id (p 8) (p 11) "one" #f)
(pattern-id (p 12) (p 15) "two" #f)
(pattern-id (p 16) (p 22) "three" 'hide))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))
(list (rule (p 1) (p 23)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq (p 8) (p 23)
(list (pattern-id (p 9) (p 12) "one" #f)
(pattern-id (p 13) (p 16) "two" #f)
(pattern-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two* three")))
(list
(rule
(p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq
(p 8) (p 22)
(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-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two+ three")))
(list
(rule
(p 1) (p 22)
(lhs-id (p 1) (p 5) "expr" #f)
(pattern-seq
(p 8) (p 22)
(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-id (p 17) (p 22) "three" #f))
#f))))
(check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two)+ three")))
(list
(rule
(p 1) (p 24)
(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+
stat: ID '=' expr
| 'print' expr
EOF
)))
(list (rule (p 1) (p 17)
(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))
(rule (p 18) (p 54)
(lhs-id (p 18) (p 22) "stat" #f)
(pattern-choice (p 24) (p 54)
(list (pattern-seq (p 24) (p 35)
(list (pattern-token (p 24) (p 26) "ID" #f)
(pattern-lit (p 27) (p 30) "=" #f)
(pattern-id (p 31) (p 35) "expr" #f))
#f)
(pattern-seq (p 42) (p 54)
(list (pattern-lit (p 42) (p 49) "print" #f)
(pattern-id (p 50) (p 54) "expr" #f))
#f))
#f))))
)))
(list
(rule (p 1) (p 17)
(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))
(rule (p 18) (p 54)
(lhs-id (p 18) (p 22) "stat" #f)
(pattern-choice (p 24) (p 54)
(list (pattern-seq (p 24) (p 35)
(list (pattern-token (p 24) (p 26) "ID" #f)
(pattern-lit (p 27) (p 30) "=" #f)
(pattern-id (p 31) (p 35) "expr" #f))
#f)
(pattern-seq (p 42) (p 54)
(list (pattern-lit (p 42) (p 49) "print" #f)
(pattern-id (p 50) (p 54) "expr" #f))
#f))
#f)))))

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

@ -1,6 +1,9 @@
#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
(require yaragg/examples/simple-arithmetic-grammar
yaragg/support
racket/set
yaragg/parser-tools/lex
racket/list
rackunit)
(define (tokenize ip)
(port-count-lines! ip)
(define lex/1
(lexer-src-pos
[(repetition 1 +inf.0 numeric)
(token 'INT (string->number lexeme))]
[whitespace
(token 'WHITESPACE #:skip? #t)]
["+"
(token '+ "+")]
["*"
(token '* "*")]
[(eof)
(token eof)]))
(lambda ()
(lex/1 ip)))
;; expr : term ('+' term)*
;; term : factor (('*') factor)*
;; factor : INT
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42"))))
'(expr (term (factor 42))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4"))))
'(expr (term (factor 3))
"+"
(term (factor 4))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4+5"))))
'(expr (term (factor 3))
"+"
(term (factor 4))
"+"
(term (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4*5"))))
'(expr (term (factor 3) "*" (factor 4) "*" (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6"))))
'(expr (term (factor 3) "*" (factor 4))
"+"
(term (factor 5) "*" (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6"))))
'(expr (term (factor 4) "*" (factor 5))
"+"
(term (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6"))))
'(expr (term (factor 4))
"+"
(term (factor 5) "*" (factor 6))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+6+")))))
(check-equal? all-token-types
(set '+ '* 'INT))
(module+ test
(require yaragg/examples/simple-arithmetic-grammar
yaragg/support
racket/set
yaragg/parser-tools/lex
racket/list
rackunit)
(define (tokenize ip)
(port-count-lines! ip)
(define lex/1
(lexer-src-pos
[(repetition 1 +inf.0 numeric)
(token 'INT (string->number lexeme))]
[whitespace
(token 'WHITESPACE #:skip? #t)]
["+"
(token '+ "+")]
["*"
(token '* "*")]
[(eof)
(token eof)]))
(lambda ()
(lex/1 ip)))
;; expr : term ('+' term)*
;; term : factor (('*') factor)*
;; factor : INT
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "42"))))
'(expr (term (factor 42))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4"))))
'(expr (term (factor 3))
"+"
(term (factor 4))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3+4+5"))))
'(expr (term (factor 3))
"+"
(term (factor 4))
"+"
(term (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4*5"))))
'(expr (term (factor 3) "*" (factor 4) "*" (factor 5))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "3*4 + 5*6"))))
'(expr (term (factor 3) "*" (factor 4))
"+"
(term (factor 5) "*" (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4*5+6"))))
'(expr (term (factor 4) "*" (factor 5))
"+"
(term (factor 6))))
(check-equal? (syntax->datum (parse #f (tokenize (open-input-string "4+5 *6"))))
'(expr (term (factor 4))
"+"
(term (factor 5) "*" (factor 6))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+")))))
(check-exn exn:fail:parsing?
(lambda () (parse #f (tokenize (open-input-string "7+6+")))))
(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
(require yaragg/examples/simple-line-drawing
yaragg/support
racket/list
yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
rackunit)
(module+ test
(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)))
(require yaragg/examples/simple-line-drawing
yaragg/support
racket/list
yaragg/parser-tools/lex
(prefix-in : yaragg/parser-tools/lex-sre)
rackunit)
(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;
6 3 b 3 X 3 b;
3 9 X;
EOF
))))
))))
(check-true (syntax-original? the-parsed-object-stx))
;; 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? the-parsed-object-stx))
;; Does the rule name "drawing" also have the proper "original?" property set?
(check-true (syntax-original? (first (syntax->list the-parsed-object-stx))))
(check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(rows (repeat 3) (chunk 9 "X") ";")))
(check-equal? (syntax->datum the-parsed-object-stx)
'(drawing (rows (repeat 3) (chunk 9 "X") ";")
(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";")
(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-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1)
(check-equal? (syntax-span the-parsed-object-stx) 28)
(check-equal? (syntax-line the-parsed-object-stx) 1)
(check-equal? (syntax-column the-parsed-object-stx) 0)
(check-equal? (syntax-position the-parsed-object-stx) 1)
(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))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (second the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 1)) 1)
(check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (third the-parsed-object))
'(rows (repeat 6) (chunk 3 " ") (chunk 3 "X") (chunk 3 " ") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 2)) 2)
(check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3)
(check-equal? (syntax->datum (fourth the-parsed-object))
'(rows (repeat 3) (chunk 9 "X") ";"))
(check-equal? (syntax-line (list-ref the-parsed-object 3)) 3))
;; 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
(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"))
(module+ test
(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
(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"))
(module+ test
(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
(require yaragg/tests/weird-grammar
rackunit)
(module+ test
(check-equal? (syntax->datum (parse '("foo")))
'(foo "foo"))
(require yaragg/tests/weird-grammar
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
(require yaragg/examples/whitespace
yaragg/support
rackunit)
(check-equal?
(parse-to-datum "\ty\n x\tz\r")
'(start (tab "\t") (letter "y") (newline "\n") (space " ") (letter "x") (tab "\t") (letter "z") (return "\r")))
(module+ test
(check-equal?
(parse-to-datum "\t\n \t\r")
'(start (tab "\t") (newline "\n") (space " ") (tab "\t") (return "\r")))
(require yaragg/examples/whitespace
yaragg/support
rackunit)
(check-equal?
(parse-to-datum "\a\b\t\n\v\f\r\e")
'(start (all "\a" "\b" "\t" "\n" "\v" "\f" "\r" "\e")))
(check-equal?
(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?
(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"))))

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

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

Write Preview
Loading…
Cancel
Save