syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Nondeterministic and Streaming tests; fixes

This commit is contained in:
Tony Garnock-Jones 2019-08-22 11:20:58 +01:00
parent adda505f45
commit 36c5d92b73
2 changed files with 81 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
implementations/racket/preserves/main.rkt
View File

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

39
tests/samples.txt
View File

@ -186,7 +186,27 @@
#false #false #false #false #false #false #false #false #false #false]>
rfc8259-example1: <NondeterministicTest
#hex{}
#hex{b2 55 496d616765
bc 55 5469746c65
5f14 566965772066726f6d203135746820466c6f6f72
59 5468756d626e61696c
b6 53 55726c
5f26 687474703a2f2f7777772e6578616d706c652e636f6d2f696d6167652f343831393839393433
56 486569676874
41 7d
55 5769647468
41 64
58 416e696d61746564
75 66616c7365
56 486569676874
42 0258
55 5769647468
42 0320
53 494473
94 41 74
42 03af
42 00ea
43 009789}
{
"Image": {
"Width": 800,
@ -203,7 +223,22 @@
}>
rfc8259-example2: <NondeterministicTest
#hex{}
#hex{92 bf10 58 4c61746974756465 03 4042e226809d4952
57 41646472657373 50
59 707265636973696f6e 53 7a6970
57 436f756e747279 52 5553
59 4c6f6e676974756465 03 c05e99566cf41f21
55 5374617465 52 4341
53 5a6970 55 3934313037
54 43697479 5d 53414e204652414e434953434f
bf10 58 4c61746974756465 03 4042af9d66adb403
57 41646472657373 50
59 707265636973696f6e 53 7a6970
57 436f756e747279 52 5553
59 4c6f6e676974756465 03 c05e81aa4fca42af
55 5374617465 52 4341
53 5a6970 55 3934303835
54 43697479 59 53554e4e5956414c45}
[
{
"precision": "zip",