From e7415fc69082fe02f6627e8827a0042354043418 Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Mon, 28 Mar 2022 16:22:12 -0700 Subject: [PATCH] Use test submodules for yaragg lang tests --- tests/test-01-equal.rkt | 51 +-- tests/test-0n1.rkt | 72 ++-- tests/test-0n1n.rkt | 75 ++-- tests/test-all.rkt | 26 -- tests/test-baby-json-hider.rkt | 49 +-- tests/test-baby-json.rkt | 55 +-- tests/test-codepoints.rkt | 16 +- tests/test-curly-quantifier.rkt | 59 +-- tests/test-cutter-another.rkt | 23 +- tests/test-cutter.rkt | 17 +- tests/test-empty-symbol.rkt | 35 +- tests/test-errors.rkt | 126 +++--- tests/test-flatten.rkt | 388 +++++++++--------- tests/test-hide-and-splice.rkt | 15 +- tests/test-lexer.rkt | 110 ++--- tests/test-make-rule-parser.rkt | 24 +- tests/test-nested-repeats.rkt | 13 +- tests/test-old-token.rkt | 110 ++--- tests/test-parser.rkt | 367 +++++++++-------- .../test-quotation-marks-and-backslashes.rkt | 11 +- tests/test-simple-arithmetic-grammar.rkt | 145 +++---- tests/test-simple-line-drawing.rkt | 98 ++--- tests/test-start-and-atok.rkt | 17 +- tests/test-top-level-cut.rkt | 18 +- tests/test-weird-grammar.rkt | 10 +- tests/test-whitespace.rkt | 27 +- tests/test-wordy.rkt | 26 +- 27 files changed, 1015 insertions(+), 968 deletions(-) delete mode 100755 tests/test-all.rkt diff --git a/tests/test-01-equal.rkt b/tests/test-01-equal.rkt index e67b9bd..a1c73b4 100755 --- a/tests/test-01-equal.rkt +++ b/tests/test-01-equal.rkt @@ -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")))) diff --git a/tests/test-0n1.rkt b/tests/test-0n1.rkt index 6ca2e0d..641b328 100755 --- a/tests/test-0n1.rkt +++ b/tests/test-0n1.rkt @@ -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"))))) diff --git a/tests/test-0n1n.rkt b/tests/test-0n1n.rkt index 7cedd0a..df29e6c 100755 --- a/tests/test-0n1n.rkt +++ b/tests/test-0n1n.rkt @@ -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")))))) diff --git a/tests/test-all.rkt b/tests/test-all.rkt deleted file mode 100755 index 50d1fb7..0000000 --- a/tests/test-all.rkt +++ /dev/null @@ -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)) diff --git a/tests/test-baby-json-hider.rkt b/tests/test-baby-json-hider.rkt index 41c606c..4c16908 100755 --- a/tests/test-baby-json-hider.rkt +++ b/tests/test-baby-json-hider.rkt @@ -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) "]")) "]")) + "]")))) diff --git a/tests/test-baby-json.rkt b/tests/test-baby-json.rkt index c8fd2c5..6f93d49 100755 --- a/tests/test-baby-json.rkt +++ b/tests/test-baby-json.rkt @@ -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)) \ No newline at end of file + (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))) diff --git a/tests/test-codepoints.rkt b/tests/test-codepoints.rkt index 232588d..ba00908 100755 --- a/tests/test-codepoints.rkt +++ b/tests/test-codepoints.rkt @@ -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")))) diff --git a/tests/test-curly-quantifier.rkt b/tests/test-curly-quantifier.rkt index cc99482..846d291 100755 --- a/tests/test-curly-quantifier.rkt +++ b/tests/test-curly-quantifier.rkt @@ -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"))) \ No newline at end of file + +(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")))) diff --git a/tests/test-cutter-another.rkt b/tests/test-cutter-another.rkt index 24a128c..0aa87f8 100755 --- a/tests/test-cutter-another.rkt +++ b/tests/test-cutter-another.rkt @@ -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))) \ No newline at end of file +(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)))) diff --git a/tests/test-cutter.rkt b/tests/test-cutter.rkt index b78fd4b..9a97cdf 100755 --- a/tests/test-cutter.rkt +++ b/tests/test-cutter.rkt @@ -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") ")")))) \ No newline at end of file +(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") ")"))))) diff --git a/tests/test-empty-symbol.rkt b/tests/test-empty-symbol.rkt index 4e56119..778cce4 100755 --- a/tests/test-empty-symbol.rkt +++ b/tests/test-empty-symbol.rkt @@ -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"))) \ No newline at end of file + ;; 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")))) diff --git a/tests/test-errors.rkt b/tests/test-errors.rkt index bf3f85c..3cb655f 100755 --- a/tests/test-errors.rkt +++ b/tests/test-errors.rkt @@ -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 #<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))))))) diff --git a/tests/test-hide-and-splice.rkt b/tests/test-hide-and-splice.rkt index b83beac..4a82014 100755 --- a/tests/test-hide-and-splice.rkt +++ b/tests/test-hide-and-splice.rkt @@ -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")) \ No newline at end of file + (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"))) diff --git a/tests/test-lexer.rkt b/tests/test-lexer.rkt index c6d37ee..4ff90bd 100755 --- a/tests/test-lexer.rkt +++ b/tests/test-lexer.rkt @@ -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 \ No newline at end of file + (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))) diff --git a/tests/test-make-rule-parser.rkt b/tests/test-make-rule-parser.rkt index 6c91d3d..1a24113 100644 --- a/tests/test-make-rule-parser.rkt +++ b/tests/test-make-rule-parser.rkt @@ -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")))) diff --git a/tests/test-nested-repeats.rkt b/tests/test-nested-repeats.rkt index 46b8ea5..a662d18 100755 --- a/tests/test-nested-repeats.rkt +++ b/tests/test-nested-repeats.rkt @@ -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"))) diff --git a/tests/test-old-token.rkt b/tests/test-old-token.rkt index 123fedd..ac40de6 100755 --- a/tests/test-old-token.rkt +++ b/tests/test-old-token.rkt @@ -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 #<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 #<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. ;; diff --git a/tests/test-parser.rkt b/tests/test-parser.rkt index cb02b0f..5719b16 100755 --- a/tests/test-parser.rkt +++ b/tests/test-parser.rkt @@ -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 #<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))) diff --git a/tests/test-simple-line-drawing.rkt b/tests/test-simple-line-drawing.rkt index e9b3a98..c2c2fd9 100755 --- a/tests/test-simple-line-drawing.rkt +++ b/tests/test-simple-line-drawing.rkt @@ -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 #<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. ;; diff --git a/tests/test-start-and-atok.rkt b/tests/test-start-and-atok.rkt index 757cc59..20519ab 100755 --- a/tests/test-start-and-atok.rkt +++ b/tests/test-start-and-atok.rkt @@ -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"))) diff --git a/tests/test-top-level-cut.rkt b/tests/test-top-level-cut.rkt index c983b26..e79d68f 100755 --- a/tests/test-top-level-cut.rkt +++ b/tests/test-top-level-cut.rkt @@ -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"))) diff --git a/tests/test-weird-grammar.rkt b/tests/test-weird-grammar.rkt index cb2cb56..962ceb2 100755 --- a/tests/test-weird-grammar.rkt +++ b/tests/test-weird-grammar.rkt @@ -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"))) diff --git a/tests/test-whitespace.rkt b/tests/test-whitespace.rkt index d01e1ea..3a24e90 100755 --- a/tests/test-whitespace.rkt +++ b/tests/test-whitespace.rkt @@ -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")))) diff --git a/tests/test-wordy.rkt b/tests/test-wordy.rkt index 157cfab..5801d83 100755 --- a/tests/test-wordy.rkt +++ b/tests/test-wordy.rkt @@ -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 "세계"))))