alltests work (except 14)

pitfall/fontkit/GPOS-test.rkt

@@ -1,8 +1,9 @@
 #lang fontkit/racket
-(require fontkit rackunit restructure)
+(require fontkit rackunit restructure racket/serialize)
 
 (define fira-path "../pitfall/test/assets/fira.ttf")
 (define f (openSync fira-path))
-(define gpos (send GPOS decode (send f _getTableStream 'GPOS)))
+(define gpos (· f GPOS))
+(define gsub (· f GSUB))
 
-(send (dict-ref gpos 'lookupList) get 2)
+(send (· gpos lookupList) get 9)

pitfall/fontkit/loca.rkt

@@ -14,31 +14,31 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
 (define-subclass VersionedStruct (Rloca)
   (define/override (process res stream)
     ;; in `restructure` `process` method, `res` is aliased as `this`
-    ;; 
+    ;;
     (when (= 16bit-style (· res version))
       ;; in a 16bits-style loca table, actual 32bit offset values are divided by 2 (to fit into 16 bits)
       ;; so we re-inflate them.
-      (hash-update! res 'offsets (λ (offsets) (map (curry * 2) offsets)))))
+      (dict-update! res 'offsets (λ (offsets) (map (curry * 2) offsets)))))
 
   (define/override (preEncode this-val stream)
     ;; this = val to be encoded
     (loca-preEncode this-val stream)))
 
 ;; make "static method"
-(define (loca-preEncode this-val . args)
+(define (loca-preEncode this . args)
   ;; this = val to be encoded
-  (unless (hash-has-key? this-val 'version)
-    (hash-set! this-val 'version (if (> (last (· this-val offsets)) max-32-bit-value)
-                                     32bit-style
-                                     16bit-style))
-    (when (= 16bit-style (· this-val version))
-      (hash-update! this-val 'offsets (λ (offsets) (map (curryr / 2) offsets))))))
+  (unless (dict-has-key? this 'version)
+    (dict-set! this 'version (if (> (last (· this offsets)) max-32-bit-value)
+                                 32bit-style
+                                 16bit-style))
+    (when (= 16bit-style (· this version))
+      (dict-update! this 'offsets (λ (offsets) (map (curryr / 2) offsets))))))
 
-(define loca (make-object Rloca
-               (λ (parent) (· parent head indexToLocFormat)) 
-               (dictify
-                0 (dictify 'offsets (+Array uint16be))
-                1 (dictify 'offsets (+Array uint32be)))))
+(define loca (+Rloca
+              (λ (o) (· o head indexToLocFormat)) 
+              (dictify
+               0 (dictify 'offsets (+Array uint16be))
+               1 (dictify 'offsets (+Array uint32be)))))
 
 
 (test-module
@@ -49,11 +49,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
  (check-equal? offset 38692)
  (check-equal? len 460)
  (define ds (+DecodeStream (peek-bytes len offset ip)))
- (send loca force-version! 0)
  (check-equal?
-  (send loca encode #f '#hash((version . 0) (offsets . (0 76 156)))) #"\0\0\0L\0\234")
+  (send loca encode #f (mhash 'version 0 'offsets '(0 76 156))) #"\0\0\0L\0\234")
  (check-equal?
   (send loca encode #f '#hash((version . 1) (offsets . (0 76 156)))) #"\0\0\0\0\0\0\0L\0\0\0\234")
+ (send loca force-version! 0)
  (define table-data (send loca decode ds))
  (check-equal? (length (· table-data offsets)) 230)
- (check-equal? (· table-data offsets) '(0 0 0 136 296 500 864 1168 1548 1628 1716 1804 1944 2048 2128 2176 2256 2312 2500 2596 2788 3052 3168 3396 3624 3732 4056 4268 4424 4564 4640 4728 4804 5012 5384 5532 5808 6012 6212 6456 6672 6916 7204 7336 7496 7740 7892 8180 8432 8648 8892 9160 9496 9764 9936 10160 10312 10536 10780 10992 11148 11216 11272 11340 11404 11444 11524 11820 12044 12216 12488 12728 12932 13324 13584 13748 13924 14128 14232 14592 14852 15044 15336 15588 15776 16020 16164 16368 16520 16744 16984 17164 17320 17532 17576 17788 17896 18036 18284 18552 18616 18988 19228 19512 19712 19796 19976 20096 20160 20224 20536 20836 20876 21000 21200 21268 21368 21452 21532 21720 21908 22036 22244 22664 22872 22932 22992 23088 23220 23268 23372 23440 23600 23752 23868 23988 24084 24184 24224 24548 24788 25012 25292 25716 25884 26292 26396 26540 26796 27172 27488 27512 27536 27560 27584 27912 27936 27960 27984 28008 28032 28056 28080 28104 28128 28152 28176 28200 28224 28248 28272 28296 28320 28344 28368 28392 28416 28440 28464 28488 28512 28536 28560 28968 28992 29016 29040 29064 29088 29112 29136 29160 29184 29208 29232 29256 29280 29304 29328 29352 29376 29400 29424 29448 29472 29496 29520 29824 30164 30220 30652 30700 30956 31224 31248 31332 31488 31636 31916 32104 32176 32484 32744 32832 32956 33248 33664 33884 34048 34072)))
+ (check-equal? (· table-data offsets) '(0 0 0 136 296 500 864 1168 1548 1628 1716 1804 1944 2048 2128 2176 2256 2312 2500 2596 2788 3052 3168 3396 3624 3732 4056 4268 4424 4564 4640 4728 4804 5012 5384 5532 5808 6012 6212 6456 6672 6916 7204 7336 7496 7740 7892 8180 8432 8648 8892 9160 9496 9764 9936 10160 10312 10536 10780 10992 11148 11216 11272 11340 11404 11444 11524 11820 12044 12216 12488 12728 12932 13324 13584 13748 13924 14128 14232 14592 14852 15044 15336 15588 15776 16020 16164 16368 16520 16744 16984 17164 17320 17532 17576 17788 17896 18036 18284 18552 18616 18988 19228 19512 19712 19796 19976 20096 20160 20224 20536 20836 20876 21000 21200 21268 21368 21452 21532 21720 21908 22036 22244 22664 22872 22932 22992 23088 23220 23268 23372 23440 23600 23752 23868 23988 24084 24184 24224 24548 24788 25012 25292 25716 25884 26292 26396 26540 26796 27172 27488 27512 27536 27560 27584 27912 27936 27960 27984 28008 28032 28056 28080 28104 28128 28152 28176 28200 28224 28248 28272 28296 28320 28344 28368 28392 28416 28440 28464 28488 28512 28536 28560 28968 28992 29016 29040 29064 29088 29112 29136 29160 29184 29208 29232 29256 29280 29304 29328 29352 29376 29400 29424 29448 29472 29496 29520 29824 30164 30220 30652 30700 30956 31224 31248 31332 31488 31636 31916 32104 32176 32484 32744 32832 32956 33248 33664 33884 34048 34072))
+ )

pitfall/fontkit/subset.rkt

@@ -111,18 +111,18 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
     (define gid (list-ref (· this glyphs) idx))
     (send this _addGlyph gid))
 
-  (define maxp (cloneDeep (· this font maxp)))
-  (hash-set! maxp 'numGlyphs (length (· this glyf)))
-
+  (define maxp (cloneDeep (send (· this font maxp) kv)))
+  (dict-set! maxp 'numGlyphs (length (· this glyf)))
   ;; populate the new loca table
-  (hash-update! (· this loca) 'offsets (λ (vals) (append vals (list (· this offset)))))
+  (dict-update! (· this loca) 'offsets (λ (vals) (append vals (list (· this offset)))))
   (loca-preEncode (· this loca))
 
-  (define head (cloneDeep (· this font head)))
-  (hash-set! head 'indexToLocFormat (· this loca version))
   
-  (define hhea (cloneDeep (· this font hhea)))
-  (hash-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
+  (define head (cloneDeep (send (· this font head) kv)))
+  (dict-set! head 'indexToLocFormat (· this loca version))
+  
+  (define hhea (cloneDeep (send (· this font hhea) kv)))
+  (dict-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
 
   (send EncodableDirectory encode stream
         (mhash 'tables

pitfall/fontkit/ttfglyph.rkt

@@ -96,16 +96,16 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
            glyph)))
 
   (define/public (_decodeSimple glyph stream)
-    (unless (hash? glyph)
+    (unless (dict? glyph)
       (raise-argument-error 'TTFGlyph-_decodeSimple "decoded RGlyfHeader" glyph))
 
     (unless (DecodeStream? stream)
       (raise-argument-error 'TTFGlyph-_decodeSimple "DecodeStream" stream))
 
     ;; this is a simple glyph
-    (hash-set! glyph 'points empty)
+    (dict-set! glyph 'points empty)
     (define endPtsOfContours (send (+Array uint16be (· glyph numberOfContours)) decode stream))
-    (hash-set! glyph 'instructions (send (+Array uint8be uint16be) decode stream))
+    (dict-set! glyph 'instructions (send (+Array uint8be uint16be) decode stream))
     (define numCoords (add1 (last endPtsOfContours)))
 
     (define flags
@@ -128,15 +128,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
        (set-field! x point next-px)
        (set-field! y point next-py)
        (values (cons point points) next-px next-py)))
-    (hash-set! glyph 'points (reverse points)))
+    (dict-set! glyph 'points (reverse points)))
 
   (define/public (_decodeComposite glyph stream [offset 0])
     ;; this is a composite glyph
-    (hash-set! glyph 'components empty)
+    (dict-set! glyph 'components empty)
     (define haveInstructions #f)
     (define flags MORE_COMPONENTS)
 
-    (hash-set! glyph 'components
+    (dict-set! glyph 'components
                (for/list ([i (in-naturals)]
                           #:break (zero? (bitwise-and flags MORE_COMPONENTS)))
                  (set! flags (send uint16be decode stream))

pitfall/pitfall/alltest.rkt

@@ -12,8 +12,8 @@
            pitfall/test/test09
            pitfall/test/test10
            pitfall/test/test11
-           ;pitfall/test/test12 ; ttf subset
-           ;pitfall/test/test13 ; subset with composites
+           pitfall/test/test12 ; ttf subset
+           pitfall/test/test13 ; subset with composites
            ;pitfall/test/test14 ; Fira ttf
            pitfall/page-test
            (submod pitfall/zlib test)))

pitfall/pitfall/test/test12.rkt

@@ -1,4 +1,4 @@
-#lang pitfall/pdftest
+ #lang pitfall/pdftest
 
 (define-runtime-path charter-path "assets/charter.ttf")
 

pitfall/restructure/array-test.rkt

@@ -90,6 +90,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
   (check-equal? (send array decode stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4)))
 
 
+; decode to the end of the stream if parent exists, but its length is 0
+(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
+      [array (+ArrayT uint8)])
+  (check-equal? (send array decode stream (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5)))
+
+
 ;    it 'should decode to the end of the stream if no parent and length is given', ->
 ;      stream = new DecodeStream new Buffer [1, 2, 3, 4]
 ;      array = new ArrayT uint8

pitfall/restructure/array.rkt

@@ -30,7 +30,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
       [(or (not length__) (eq? lengthType 'bytes))
        (define target (cond
                         [length__ (+ (send stream pos) length__)]
-                        [(and parent (· parent _length))
+                        [(and parent (positive? (· parent _length)))
                          (+ (ref parent '_startOffset)
                             (ref parent '_length))]
                         [else (· stream length_)]))

pitfall/restructure/string.rkt

@@ -11,7 +11,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
   (define encoder
     (caseq encoding
          [(ascii utf8) string->bytes/utf-8]))
-  (bytes-length (encoder val)))
+  (bytes-length (encoder (format "~a" val))))
 
 (define-subclass Streamcoder (StringT [length_ #f] [encoding_ 'ascii])
          
@@ -30,7 +30,8 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
     string)
     
 
-  (define/augment (encode stream val [parent #f])
+  (define/augment (encode stream val-in [parent #f])
+    (define val (format "~a" val-in))
     (define encoding__
          (cond
            [(procedure? encoding_) (or (encoding_ (and parent (· parent val)) 'ascii))]

pitfall/restructure/versioned-struct.rkt

@@ -6,6 +6,8 @@
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 |#
+(define key? symbol?)
+(define (keys? x) (and (pair? x) (andmap key? x)))
 
 (define-subclass Struct (VersionedStruct type [versions (dictify)])
   
@@ -20,17 +22,22 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
          [versionGetter void]
          [versionSetter void])
 
-  (when (symbol? type) ; instead of string
-    (set-field! versionGetter this (λ (parent) (ref parent type)))
-    (set-field! versionSetter this (λ (parent version) (ref-set! parent type version))))
+  (when (or (key? type) (procedure? type))
+    (set-field! versionGetter this (if (procedure? type)
+                                       type
+                                       (λ (parent) (ref parent type))))
+    (set-field! versionSetter this (if (procedure? type)
+                                       type
+                                       (λ (parent version) (ref-set! parent type version)))))
 
   (define/override (decode stream [parent #f] [length 0])
     (define res (_setup stream parent length))
-    
+
     (ref-set! res 'version
               (cond
                 [forced-version] ; for testing purposes: pass an explicit version
-                [(symbol? type) (unless parent
+                [(or (key? type) (procedure? type))
+                 (unless parent
                                   (raise-argument-error 'VersionedStruct:decode "valid parent" parent))
                                 (versionGetter parent)]
                 [else (send type decode stream)]))
@@ -40,6 +47,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     
     (define fields (or (ref versions (ref res 'version)) (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions)))))
 
+    
     (cond
       [(VersionedStruct? fields) (send fields decode stream parent)]
       [else
@@ -64,23 +72,23 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 
     (ref-set! ctx 'pointerOffset (+ (· stream pos) (size val ctx #f)))
 
-    (when (not (symbol? type))
-      (send type encode stream (· val version)))
+    (when (not (or (key? type) (procedure? type)))
+      (send type encode stream (or forced-version (· val version))))
 
     (when (ref versions 'header)
       (for ([(key type) (in-dict (ref versions 'header))])
-        (send type encode stream (ref val key) ctx)))
+           (send type encode stream (ref val key) ctx)))
 
-    (define fields (or (ref versions (· val version)) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
+    (define fields (or (ref versions (or forced-version (· val version))) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
 
     (unless (andmap (λ (key) (member key (ref-keys val))) (ref-keys fields))
       (raise-argument-error 'VersionedStruct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
 
     (for ([(key type) (in-dict fields)])
-        (send type encode stream (ref val key) ctx))
+         (send type encode stream (ref val key) ctx))
 
     (for ([ptr (in-list (ref ctx 'pointers))])
-      (send (ref ptr 'type) encode stream (ref ptr 'val) (ref ptr 'parent))))
+         (send (ref ptr 'type) encode stream (ref ptr 'val) (ref ptr 'parent))))
 
   
   (define/override (size [val (mhash)] [parent #f] [includePointers #t])
@@ -92,19 +100,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
                        'pointerSize 0))
 
     (define size 0)
-    (when (not (symbol? type))
-      (increment! size (send type size (ref val 'version) ctx)))
-
+    (when (not (or (key? type) (procedure? type)))
+      (increment! size (send type size (or forced-version (ref val 'version)) ctx)))
+ 
     (when (ref versions 'header)
       (increment! size
                   (for/sum ([(key type) (in-dict (ref versions 'header))])
-                    (send type size (ref val key) ctx))))
+                           (send type size (ref val key) ctx))))
     
-    (define fields (or (ref versions (ref val 'version)) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
+    (define fields (or (ref versions (or forced-version (ref val 'version))) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
 
     (increment! size
                 (for/sum ([(key type) (in-dict fields)])
-                  (send type size (ref val key) ctx)))
+                         (send type size (ref val key) ctx)))
 
     (when includePointers
       (increment! size (ref ctx 'pointerSize)))
@@ -118,21 +126,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 
    ;; make random versioned structs and make sure we can round trip
    #;(for ([i (in-range 1)])
-     (define field-types (for/list ([i (in-range 1)])
-                           (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
-     (define num-versions 20)
-     (define which-struct (random num-versions))
-     (define struct-versions (for/list ([v (in-range num-versions)])
-                               (cons v (for/list ([num-type (in-list field-types)])
-                                         (cons (gensym) num-type)))))
-     (define vs (+VersionedStruct which-struct struct-versions))
-     (report* vs (send vs size))
-     (error 'stop)
-     (define struct-size (for/sum ([num-type (in-list (map cdr (ref struct-versions which-struct)))])
-                           (send num-type size)))
-     (define bs (apply bytes (for/list ([i (in-range struct-size)])
-                               (random 256))))
-     (check-equal? (send vs encode #f (send vs decode bs)) bs))
+          (define field-types (for/list ([i (in-range 1)])
+                                        (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
+          (define num-versions 20)
+          (define which-struct (random num-versions))
+          (define struct-versions (for/list ([v (in-range num-versions)])
+                                            (cons v (for/list ([num-type (in-list field-types)])
+                                                              (cons (gensym) num-type)))))
+          (define vs (+VersionedStruct which-struct struct-versions))
+          (define struct-size (for/sum ([num-type (in-list (map cdr (ref struct-versions which-struct)))])
+                                       (send num-type size)))
+          (define bs (apply bytes (for/list ([i (in-range struct-size)])
+                                            (random 256))))
+          (check-equal? (send vs encode #f (send vs decode bs)) bs))
 
    (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
    (check-equal? (send s size) 3)

pitfall/sugar/case.rkt

@@ -17,3 +17,8 @@
 (define-case-macro caseq memq)
 (define-case-macro casev memv)
 
+
+(require sugar/debug)
+(define-macro-cases cond-report
+  [(_ [COND . BODY] ... [else . ELSE-BODY]) #'(cond [(report COND) (report (let () (void) . BODY))] ... [else . ELSE-BODY])]
+  [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])]) 

pitfall/sugar/js.rkt

@@ -57,20 +57,21 @@
          [(and (dict? x) (dict-ref x 'REF #f))]
          [(dict? x) #f]
          [(and (object? x) (or (get-or-false x REF) (send-or-false x REF)))]
-         [(object? x) #f]         [else (raise-argument-error '· (format "~a must be object or dict" 'X) x)]))]
+         [(object? x) #f]
+         [else (raise-argument-error '· (format "~a must be object or dict" 'X) x)]))]
   [(_ X REF0 . REFS) #'(· (· X REF0) . REFS)])
 
 #;(module+ test
-  (define c (class object%
-              (super-new)
-              (field [a 42])
-              (define/public (res) (hash 'res (hash 'b 43)))))
-  (define co (make-object c))
-  (define h2 (hash 'a 42 'res co))
-  (check-equal? (· h2 a) 42)
-  (check-equal? (· h2 b) 43)
-  (check-equal? (· co a) 42)
-  (check-equal? (· co b) 43))
+    (define c (class object%
+                (super-new)
+                (field [a 42])
+                (define/public (res) (hash 'res (hash 'b 43)))))
+    (define co (make-object c))
+    (define h2 (hash 'a 42 'res co))
+    (check-equal? (· h2 a) 42)
+    (check-equal? (· h2 b) 43)
+    (check-equal? (· co a) 42)
+    (check-equal? (· co b) 43))
 
 (define-macro (·map REF XS)
   #'(for/list ([x (in-list XS)]) (· x REF)))