From 36c5d92b7383a34f17de9a256d3eec184aa3f056 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 22 Aug 2019 11:20:58 +0100 Subject: [PATCH] Nondeterministic and Streaming tests; fixes --- implementations/racket/preserves/main.rkt | 74 ++++++++++++++--------- tests/samples.txt | 39 +++++++++++- 2 files changed, 81 insertions(+), 32 deletions(-) diff --git a/implementations/racket/preserves/main.rkt b/implementations/racket/preserves/main.rkt index 2d292db..1e59ec3 100644 --- a/implementations/racket/preserves/main.rkt +++ b/implementations/racket/preserves/main.rkt @@ -34,7 +34,7 @@ (require "varint.rkt") (require (only-in syntax/readerr raise-read-error raise-read-eof-error)) -(struct stream-of (kind generator) #:transparent) +(struct stream-of (kind generator-thunk) #:transparent) ;; Syntax properties and syntax objects would be almost perfect for ;; representing annotations, plus position/source tracking as @@ -163,12 +163,12 @@ (map (lambda (a) (bit-string #b00000101 ((encode-value a) :: binary))) annotations)) :: binary) ((encode-value item) :: binary))] - [(stream-of 'string p) (encode-stream 1 1 bytes? p)] - [(stream-of 'byte-string p) (encode-stream 1 2 bytes? p)] - [(stream-of 'symbol p) (encode-stream 1 3 bytes? p)] - [(stream-of 'sequence p) (encode-stream 2 1 (lambda (x) #t) p)] - [(stream-of 'set p) (encode-stream 2 2 (lambda (x) #t) p)] - [(stream-of 'dictionary p) (encode-stream 2 3 (lambda (x) #t) p)] + [(stream-of 'string p) (encode-stream 1 1 bytes? (p))] + [(stream-of 'byte-string p) (encode-stream 1 2 bytes? (p))] + [(stream-of 'symbol p) (encode-stream 1 3 bytes? (p))] + [(stream-of 'sequence p) (encode-stream 2 1 (lambda (x) #t) (p))] + [(stream-of 'set p) (encode-stream 2 2 (lambda (x) #t) (p))] + [(stream-of 'dictionary p) (encode-stream 2 3 (lambda (x) #t) (p))] [(? integer? x) #:when (<= -3 x 12) (bit-string (#b0011 :: bits 4) (x :: bits 4))] ;; [0 (bytes #b10000000)] @@ -860,21 +860,24 @@ (struct asymmetric (forward back)) + (define (stream-of* kind . items) + (stream-of kind (lambda () (sequence->generator items)))) + (define samples-txt-expected (hash 'record1 (capture (discard)) 'record2 (observe (speak (discard) (capture (discard)))) 'list4a '(1 2 3 4) - 'list1 (asymmetric (stream-of 'sequence (sequence->generator '(1 2 3 4))) + 'list1 (asymmetric (stream-of* 'sequence 1 2 3 4) '(1 2 3 4)) 'list5 '(-2 -1 0 1) 'string3 "hello" - 'string2 (asymmetric (stream-of 'string (sequence->generator '(#"he" #"llo"))) + 'string2 (asymmetric (stream-of* 'string #"he" #"llo") "hello") - 'string1 (asymmetric (stream-of 'string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + 'string1 (asymmetric (stream-of* 'string #"he" #"ll" #"o") "hello") - 'bytes1 (asymmetric (stream-of 'byte-string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + 'bytes1 (asymmetric (stream-of* 'byte-string #"he" #"ll" #"o") #"hello") - 'symbol1 (asymmetric (stream-of 'symbol (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + 'symbol1 (asymmetric (stream-of* 'symbol #"he" #"ll" #"o") 'hello) 'list6 `("hello" there #"world" () ,(set) #t #f) 'bytes2 #"hello" @@ -895,7 +898,7 @@ 'list0 '() 'dict0 (hash) 'string0 "" - 'string0a (asymmetric (stream-of 'string (sequence->generator '())) + 'string0a (asymmetric (stream-of* 'string) "") 'symbol0 '|| 'set0 (set) @@ -904,11 +907,12 @@ 'string4 "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz" 'bytes13 #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz" 'string5 "\U0001D11E" - 'list2 (asymmetric (stream-of 'sequence - (sequence->generator - (list (stream-of 'string (sequence->generator '(#"abc"))) - (stream-of 'string (sequence->generator '(#"def")))))) + 'list2 (asymmetric (stream-of* 'sequence + (stream-of* 'string #"abc") + (stream-of* 'string #"def")) '("abc" "def")) + 'list3 (asymmetric (stream-of* 'sequence '("a" 1) '("b" 2) '("c" 3)) + '(("a" 1) ("b" 2) ("c" 3))) 'record1 (capture (discard)) 'record2 (observe (speak (discard) (capture (discard)))) 'record3 (titled 101 "Blackwell" (date 1821 2 3) "Dr") @@ -930,7 +934,7 @@ "Thumbnail" (hash "Url" "http://www.example.com/image/481989943" "Height" 125 "Width" 100) - "Animated" #f + "Animated" 'false "IDs" (list 116 943 234 38793))) 'rfc8259-example2 (list (hash "precision" "zip" @@ -960,6 +964,23 @@ 'annotation6 (asymmetric (record (annotate 'R 'ar) (list (annotate 'f 'af))) `#s(R f)) )) + (define (run-test-case variety t-name loc binary-form annotated-text-form) + (define text-form (strip-annotations annotated-text-form)) + (define-values (forward back) + (match (hash-ref samples-txt-expected t-name text-form) + [(asymmetric f b) (values f b)] + [v (values v v)])) + (check-equal? text-form back loc) + (check-equal? (d-strip (encode text-form)) back loc) + (check-equal? (d-strip (encode forward)) back loc) + (check-equal? (d-strip binary-form) back loc) + (check-equal? (d binary-form) annotated-text-form loc) + (check-equal? (d (encode annotated-text-form)) annotated-text-form loc) + (unless (memq variety '(nondeterministic)) + (check-equal? (encode forward) binary-form loc)) + (unless (memq variety '(nondeterministic streaming)) + (check-equal? (encode annotated-text-form) binary-form loc))) + (define-runtime-path tests-path "../../../tests") (let* ((path (build-path tests-path "samples.txt")) (tests (call-with-input-file path @@ -987,18 +1008,11 @@ (displayln loc) (match (peel-annotations t*) [`#s(Test ,(strip-annotations binary-form) ,annotated-text-form) - (define text-form (strip-annotations annotated-text-form)) - (define-values (forward back) - (match (hash-ref samples-txt-expected t-name text-form) - [(asymmetric f b) (values f b)] - [v (values v v)])) - (check-equal? text-form back loc) - (check-equal? (d-strip (encode text-form)) back loc) - (check-equal? (d-strip (encode forward)) back loc) - (check-equal? (d-strip binary-form) back loc) - (check-equal? (d binary-form) annotated-text-form loc) - (check-equal? (encode forward) binary-form loc) - (check-equal? (encode annotated-text-form) binary-form loc)] + (run-test-case 'normal t-name loc binary-form annotated-text-form)] + [`#s(NondeterministicTest ,(strip-annotations binary-form) ,annotated-text-form) + (run-test-case 'nondeterministic t-name loc binary-form annotated-text-form)] + [`#s(StreamingTest ,(strip-annotations binary-form) ,annotated-text-form) + (run-test-case 'streaming t-name loc binary-form annotated-text-form)] [`#s(ParseError ,(strip-annotations str)) (with-handlers [(exn:fail:read:eof? (lambda (e) (fail-test "Unexpected EOF: ~e" e))) diff --git a/tests/samples.txt b/tests/samples.txt index 8651281..fa0de16 100644 --- a/tests/samples.txt +++ b/tests/samples.txt @@ -186,7 +186,27 @@ #false #false #false #false #false #false #false #false #false #false]> rfc8259-example1: rfc8259-example2: