- Implemented a blob (binary large object) library.

1 files changed, 107 insertions, 0 deletions

diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux
new file mode 100644
index 000000000..23dcd889c
--- /dev/null
+++ b/stdlib/test/test/lux/world/blob.lux
@@ -0,0 +1,107 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                [pipe])
+       (data [bit]
+             ["R" result]
+             (coll [list]))
+       (world ["@" blob])
+       ["r" math/random])
+  lux/test)
+
+(def: (succeed result)
+  (-> (R;Result Bool) Bool)
+  (case result
+    (#R;Error _)
+    false
+
+    (#R;Success output)
+    output))
+
+(def: #export (blob size)
+  (-> Nat (r;Random @;Blob))
+  (let [blob (@;create size)]
+    (do r;Monad<Random>
+      []
+      (loop [idx +0]
+        (if (n.< size idx)
+          (do @
+            [byte r;nat]
+            (exec (R;assume (@;write-8 idx byte blob))
+              (recur (n.inc idx))))
+          (wrap blob))))))
+
+(context: "Blob."
+  [blob-size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +8))))
+   random-blob (blob blob-size)
+   #let [clean-blob (@;create blob-size)
+         size (@;size clean-blob)]
+   value r;nat
+   idx (|> r;nat (:: @ map (n.% size)))
+   [from to] (|> (r;list +2 (|> r;nat (:: @ map (n.% size))))
+                 (:: @ map
+                     (|>. (list;sort n.<)
+                          (pipe;case> (^ (list from to))
+                                      [from to]
+
+                                      _
+                                      (undefined)))))
+   #let [value-8 (n.% (bit;shift-left +8 +1) value)
+         value-16 (n.% (bit;shift-left +16 +1) value)
+         value-32 (n.% (bit;shift-left +32 +1) value)
+         value-64 value
+         slice-size (|> to (n.- from) n.inc)
+         random-slice (R;assume (@;slice from to random-blob))]]
+  ($_ seq
+      (test "Has equality."
+            (and (:: @;Eq<Blob> = clean-blob clean-blob)
+                 (:: @;Eq<Blob> =
+                     (R;assume (@;slice from to clean-blob))
+                     (R;assume (@;slice from to clean-blob)))))
+      (test "Can get size of blob."
+            (n.= blob-size size))
+      (test "Can read/write 8-bit values."
+            (succeed
+             (do R;Monad<Result>
+               [_ (@;write-8 idx value-8 clean-blob)
+                output-8 (@;read-8 idx clean-blob)]
+               (wrap (n.= value-8 output-8)))))
+      (test "Can read/write 16-bit values."
+            (or (n.>= size (n.+ +1 idx))
+                (succeed
+                 (do R;Monad<Result>
+                   [_ (@;write-16 idx value-16 clean-blob)
+                    output-16 (@;read-16 idx clean-blob)]
+                   (wrap (n.= value-16 output-16))))))
+      (test "Can read/write 32-bit values."
+            (or (n.>= size (n.+ +3 idx))
+                (succeed
+                 (do R;Monad<Result>
+                   [_ (@;write-32 idx value-32 clean-blob)
+                    output-32 (@;read-32 idx clean-blob)]
+                   (wrap (n.= value-32 output-32))))))
+      (test "Can read/write 64-bit values."
+            (or (n.>= size (n.+ +7 idx))
+                (succeed
+                 (do R;Monad<Result>
+                   [_ (@;write-64 idx value-64 clean-blob)
+                    output-64 (@;read-64 idx clean-blob)]
+                   (wrap (n.= value-64 output-64))))))
+      (test "Can slice blobs."
+            (and (n.= slice-size (@;size random-slice))
+                 (loop [idx +0]
+                   (let [loop-recur recur]
+                     (if (n.< slice-size idx)
+                       (and (succeed
+                             (do R;Monad<Result>
+                               [reference (@;read-8 (n.+ from idx) random-blob)
+                                sample (@;read-8 idx random-slice)]
+                               (wrap (n.= reference sample))))
+                            (loop-recur (n.inc idx)))
+                       true)))))
+      (test "Slicing the whole blob does not change anything."
+            (:: @;Eq<Blob> =
+                random-blob
+                (R;assume (@;slice +0 (n.dec blob-size) random-blob))))
+      ))