- Added tests for fasl objects

- fasl-read can now read bignums, flonums, and ratnums.

scheme/ikarus.fasl.ss

@@ -336,6 +336,34 @@
                     (vector-set! fields i 
                       (list (if field-mutable? 'mutable 'immutable) field-name))
                     (f (+ i 1)))])))]
+          [(#\b) ;;; bignum
+           (let ([i (read-int p)]) 
+             (let ([bytes (if (< i 0) (- i) i)])
+               (let ([bv (get-bytevector-n p bytes)])
+                 (let ([n (bytevector-uint-ref bv 0 'little bytes)])
+                   (let ([n (if (< i 0) (- n) n)])
+                     (when m (put-mark m n))
+                     n)))))]
+          [(#\f) ;;; flonum
+           (let ()
+             (import (ikarus system $flonums))
+             (let ([x ($make-flonum)])
+               ($flonum-set! x 7 (get-u8 p))
+               ($flonum-set! x 6 (get-u8 p))
+               ($flonum-set! x 5 (get-u8 p))
+               ($flonum-set! x 4 (get-u8 p))
+               ($flonum-set! x 3 (get-u8 p))
+               ($flonum-set! x 2 (get-u8 p))
+               ($flonum-set! x 1 (get-u8 p))
+               ($flonum-set! x 0 (get-u8 p))
+               (when m (put-mark m x))
+               x))]
+          [(#\r) ;;; ratnum
+           (let* ([den (read)]
+                  [num (read)])
+             (let ([x (/ num den)])
+               (when m (put-mark m x))
+               x))]
           [else
            (die who "Unexpected char as a fasl object header" h)])))
     (read))

scheme/last-revision

@@ -1 +1 @@
-1410
+1411

scheme/run-tests.ss

@@ -35,6 +35,7 @@
         (tests io)
         (tests case-folding)
         (tests sorting)
+        (tests fasl)
         )
 
 (define (test-exact-integer-sqrt)
@@ -77,4 +78,5 @@
 (test-bitwise-bit-count)
 (test-io)
 (test-sorting)
+(test-fasl)
 (printf "Happy Happy Joy Joy\n")

scheme/tests/fasl.ss

@@ -0,0 +1,32 @@
+
+(library (tests fasl)
+  (export test-fasl)
+  (import (ikarus) (tests framework))
+
+  (define (test x)
+    (printf "test-fasl ~s\n" x)
+    (let-values ([(p e) (open-bytevector-output-port)])
+      (fasl-write x p)
+      (let ([bv (e)])
+        (let ([y (fasl-read (open-bytevector-input-port bv))])
+          (unless (equal? x y)
+            (error 'test-fasl "failed/expected" y x))))))
+
+  (define (test-fasl) 
+    (test 12)
+    (test -12)
+    (test 0)
+    (test #t)
+    (test #f)
+    (test '())
+    (test 'hello)
+    (test "Hello")
+    (test '(Hello There))
+    (test 3498798327498723894789237489324)
+    (test -3498798327498723894789237489324)
+    (test 2389478923749872389723894/23498739874892379482374)
+    (test -2389478923749872389723894/23498739874892379482374)))
+
+
+
+