From 330744397af2137d4a48b7e28c5b99d6b8ccb129 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Wed, 27 Sep 2023 23:24:17 +0000 Subject: [PATCH 1/2] Fix basic-parsers, add test --- src/std/text/basic-parsers-test.ss | 24 ++++++++++++++++++++++++ src/std/text/basic-parsers.ss | 2 +- 2 files changed, 25 insertions(+), 1 deletion(-) create mode 100644 src/std/text/basic-parsers-test.ss diff --git a/src/std/text/basic-parsers-test.ss b/src/std/text/basic-parsers-test.ss new file mode 100644 index 000000000..c4e5726f7 --- /dev/null +++ b/src/std/text/basic-parsers-test.ss @@ -0,0 +1,24 @@ +(import + :std/error + (only-in :std/parser/base parse-error?) + :std/sugar + :std/test + :std/text + :std/text/basic-parsers) + +(export basic-parsers-test) + +(def (check-parse parser string result) + (check-equal? (parse-string parser string) result) + (check-equal? (call-with-input-string (parse-port parser port) string) result)) +(def (check-parse-error parser string) + (check-exception (parse-string parser string) parse-error?) + (check-exception (call-with-input-string (parse-port parser port) string) parse-error?)) + +(def basic-parsers-test + (test-suite "test suite for std/misc/basic-parsers" + (test-case "1" + (check-parse parse-natural "1" 1) + (check-parse-error parse-natural "1 ")) + (test-case "1" + (check-equal? 1 1)))) diff --git a/src/std/text/basic-parsers.ss b/src/std/text/basic-parsers.ss index 0848fcd12..08e364e60 100644 --- a/src/std/text/basic-parsers.ss +++ b/src/std/text/basic-parsers.ss @@ -157,7 +157,7 @@ ;; Parse an entire port (def (parse-port parser port (description port) (where 'parse-port)) - (parse-reader parser (PeekableStringReader (make-raw-input-port port)) description where)) + (parse-reader parser (PeekableStringReader (make-raw-textual-input-port port)) description where)) ;; Parse an entire file (def (parse-file parser file (description file) (where 'parse-file)) From 39c5c24605d852002aca029bc28673ff993880dd Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Wed, 27 Sep 2023 23:49:15 +0000 Subject: [PATCH 2/2] Fix some early bitrot in basic-parsers, add tests --- src/std/text/basic-parsers-test.ss | 22 +++++++++++++--------- src/std/text/basic-parsers.ss | 2 +- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/std/text/basic-parsers-test.ss b/src/std/text/basic-parsers-test.ss index c4e5726f7..7755c7160 100644 --- a/src/std/text/basic-parsers-test.ss +++ b/src/std/text/basic-parsers-test.ss @@ -3,22 +3,26 @@ (only-in :std/parser/base parse-error?) :std/sugar :std/test - :std/text :std/text/basic-parsers) (export basic-parsers-test) -(def (check-parse parser string result) - (check-equal? (parse-string parser string) result) - (check-equal? (call-with-input-string (parse-port parser port) string) result)) -(def (check-parse-error parser string) - (check-exception (parse-string parser string) parse-error?) - (check-exception (call-with-input-string (parse-port parser port) string) parse-error?)) +(defrule (check-parse parser string result) + (begin + (check-equal? (parse-string parser string) result) + (check-equal? (call-with-input-string string (cut parse-port parser <>)) result))) +(defrule (check-parse-error parser string) + (begin + (check-exception (parse-string parser string) parse-error?) + (check-exception (call-with-input-string string (cut parse-port parser <>)) parse-error?))) (def basic-parsers-test (test-suite "test suite for std/misc/basic-parsers" (test-case "1" (check-parse parse-natural "1" 1) - (check-parse-error parse-natural "1 ")) - (test-case "1" + (check-parse parse-natural "010" 10) ;; ain't no octal + (check-parse (cut parse-natural <> 8) "10" 8) ;; octal this time. + (check-parse-error parse-natural " 1") ;; no space allowed in front unless you ask + (check-parse-error parse-natural "1 no junk allowed")) + (test-case "parse-integer" (check-equal? 1 1)))) diff --git a/src/std/text/basic-parsers.ss b/src/std/text/basic-parsers.ss index 08e364e60..5286da79a 100644 --- a/src/std/text/basic-parsers.ss +++ b/src/std/text/basic-parsers.ss @@ -198,7 +198,7 @@ (parse-or (parse-begin parse-terminator (parse-pure '())) (parse-bind parse-element - (lambda (e) (parse-repeated (parse-begin parse-separator parse-element) + (lambda (e) (parse-repeated (parse-begin parse-separator parse-element) parse-terminator [e]))))) (def ((parse-n-repeats n parse-element) reader) (for/collect ((_ (in-range n))) (parse-element reader)))