Commits

Anonymous committed 2432571

Rename exported library functions. Add some tests. At the moment of this writing Racket 5.0 and Chez Scheme 8.0 pass the tests.

Comments (0)

Files changed (3)

 
 Installation for Racket:
 
-    $ plt-r6rs --install erl-ext-types.ss
+    $ plt-r6rs --install ./src/scheme-bert.ss
 
-Then just (import (encode))
-
+(see http://docs.racket-lang.org/r6rs/Installing_Libraries.html for more info)
 
 Usage
 -----
+
+Issue `(import (scheme-bert))` in your REPL or put this in head of your source file.
+You will also probably want to import some other libraries such as `bytevectors`.
+
 
     (encode (vector 'foo 42 666 (vector 12 '() (vector 255 'bar) 111222333444555666)))
     =>

src/scheme-bert.ss

 #!r6rs
 (library (scheme-bert)
-         (export encode decode)
+         (export bert-encode bert-decode)
          (import (rnrs base)
                  (rnrs bytevectors)
                  (rnrs lists)
                  (rnrs unicode)
                  ;; Either import SRFI 19 or use 
                  ;; builtin functions (as in Chez Scheme))
-                 ;(srfi :19)
-                 (only (chezscheme) time-nanosecond time-second time? make-time)
+                 (srfi :19)
+                 ;(only (chezscheme) time-nanosecond time-second time? make-time)
                  )
          
          ;; Erlang external term format types
                         (div (time-nanosecond obj) 1000))))
              (else obj)))
          
-         (define (encode obj)
+         (define (bert-encode obj)
            (call-with-bytevector-output-port 
             (lambda(outpr) (write-any outpr (convert obj)))))
          
-         (define (encode-pretty obj)
-           (bytevector->u8-list (encode obj)))         
-         
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;; Floating-point processing routines
          
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;; Decoder part
          
-         (define (decode bytevector)
+         (define (bert-decode bytevector)
            (read-any (open-bytevector-input-port bytevector)))
          
          (define (read-any inp)
+#!r6rs
+(import (scheme-bert)
+        (rnrs)
+        (rnrs bytevectors)        
+        ;; Either import SRFI 19 or use 
+        ;; builtin functions (as in Chez Scheme))
+        (srfi :19)
+        ;(only (chezscheme) time-nanosecond time-second time? make-time)
+        )
+
+(define (fold/and proc lst)
+  (cond
+    ((null? lst)
+     #t)
+    ((proc (car lst))
+     (fold/and proc (cdr lst)))
+    (else #f)))
+
+(define (checkthis testname expect exprresult)
+  (if (equal? expect exprresult)
+      #t
+      (begin
+        (display (string-append testname ": failed"))
+        (newline)
+        #f)))
+
+(define (test-encoder)
+  (let* ((result (list (test-encoder-1)
+                       (test-encoder-time)
+                       (test-bignum)))
+         (suc (filter (lambda (x) x) result))
+         (fail (filter not result)))
+    (display "=== Performing encoder test ===") (newline)
+    (display (string-append "Successful: " 
+                            (number->string (length suc))
+                            ". " 
+                            "Failed: " (number->string (length fail))))
+    (newline) (display "Encoder test done.") (newline)))
+
+(define (test-bert)
+  (let* ((result (list (test-hash)))
+         (suc (filter (lambda (x) x) result))
+         (fail (filter not result)))
+    (display "=== Performing roundtrip tests ===") (newline)
+    (display (string-append "Successful: " 
+                            (number->string (length suc))
+                            ". " 
+                            "Failed: " (number->string (length fail))))
+    (newline) (display "Tests done.") (newline)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Encoder test cases
+;;
+(define (test-encoder-1)
+  ; {foo,42,666,{12,[],{255,'Bar'},111222333444555666}}
+  (checkthis "test-encoder-1"
+             (u8-list->bytevector '(131 104 4 100 0 3 102 111 111 97 42 
+                                        98 0 0 2 154 104 4 97 12 106 104 
+                                        2 97 255 100 0 3 98 97 114 110 8 
+                                        0 146 131 13 124 31 36 139 1))
+             (bert-encode 
+              (vector 'foo 42 666 
+                      (vector 12 '() 
+                              (vector 255 'bar) 111222333444555666)))))
+
+(define (test-encoder-time)
+  ; {bert, time, <some_day_bleh>}
+  (checkthis "test-encoder-time"
+             (bert-encode (make-time 'time-utc 42424242 502806141))
+             (u8-list->bytevector '(131 104 5 100 0 4 98 101 114 
+                                        116 100 0 4 116 105 109 101
+                                        98 0 0 1 246 98 0 12 76 253
+                                        98 0 0 165 184))))
+
+(define (test-bignum)
+  ; http://goo.gl/E9od   Haha
+  (checkthis "test-bignum"
+             (bert-encode 
+              54308428790203478762340052723346983453487023489987231275412390872348475)
+             (u8-list->bytevector '(131 110 30 0 59 247 203 187 60 
+                                        16 162 156 242 204 91 91 185 
+                                        157 61 237 199 186 60 55 104 
+                                        86 102 152 206 95 93 105 222 7))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Decoder test cases
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Roundtrip (encode->decode and vice versa) test cases
+;;
+(define (test-hash)
+  ; {bert,dict,[{one,1},{two,2},{three,3}]}
+  (let ((h1 (make-eqv-hashtable)))
+    (hashtable-set! h1 13  'thirteen)
+    (hashtable-set! h1 42  'fortytwo)
+    (hashtable-set! h1 666 'beast)
+    (let ((h2 (bert-decode (bert-encode h1))))
+      (let-values (((keys1 vals1) (hashtable-entries h1))
+                   ((keys2 vals2) (hashtable-entries h2)))
+        (checkthis "test-hash" #t
+                   (and
+                    (fold/and (lambda (x) (member x (vector->list keys2)))
+                              (vector->list keys2))
+                    (fold/and (lambda (x) (member x (vector->list vals2)))
+                              (vector->list vals2))))))))