From 91cd93a50347d39c286366c32c723fd861c5975e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 25 Mar 2019 00:03:22 -0400 Subject: Ported tests for world-related modules. --- stdlib/source/lux/world/net.lux | 14 +- stdlib/source/lux/world/net/tcp.jvm.lux | 70 ++++--- stdlib/source/lux/world/net/udp.jvm.lux | 60 +++--- stdlib/source/test/lux.lux | 11 +- stdlib/source/test/lux/world.lux | 19 ++ stdlib/source/test/lux/world/binary.lux | 87 +++++---- stdlib/source/test/lux/world/file.lux | 318 ++++++++++++++++--------------- stdlib/source/test/lux/world/net/tcp.lux | 104 +++++----- stdlib/source/test/lux/world/net/udp.lux | 90 ++++----- 9 files changed, 409 insertions(+), 364 deletions(-) create mode 100644 stdlib/source/test/lux/world.lux diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux index a56c9c62e..ff753f527 100644 --- a/stdlib/source/lux/world/net.lux +++ b/stdlib/source/lux/world/net.lux @@ -4,7 +4,7 @@ [error (#+ Error)]] [control [security - [capability (#+ Capability)]]]]) + ["!" capability (#+ capability:)]]]]) (type: #export Address Text) @@ -16,11 +16,11 @@ {#address Address #port Port}) -(type: #export (Can-Read ! o) - (Capability Nat (! (Error o)))) +(capability: #export (Can-Read ! o) + (can-read Nat (! (Error o)))) -(type: #export (Can-Write ! i) - (Capability i (! (Error Any)))) +(capability: #export (Can-Write ! i) + (can-write i (! (Error Any)))) -(type: #export (Can-Close !) - (Capability [] (! (Error Any)))) +(capability: #export (Can-Close !) + (can-close [] (! (Error Any)))) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 35b2e31f0..7ff25d6ee 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -3,8 +3,10 @@ [control monad [concurrency - ["." promise (#+ Promise promise)] - ["." frp]]] + ["." promise (#+ Promise Resolver)] + ["." frp (#+ Channel Sink)]] + [security + ["!" capability]]] [data ["." error (#+ Error)]] [world @@ -53,10 +55,12 @@ (def: #export (async tcp) (-> (TCP IO) (TCP Promise)) - (`` (structure (~~ (do-template [] - [(def: (|>> (:: tcp ) promise.future))] + (`` (structure (~~ (do-template [ ] + [(def: ( (|>> (!.use (:: tcp )) promise.future)))] - [read] [write] [close]))))) + [read //.can-read] + [write //.can-write] + [close //.can-close]))))) (`` (for {(~~ (static host.jvm)) (as-is (def: (tcp socket) @@ -65,24 +69,30 @@ [input (Socket::getInputStream socket) output (Socket::getOutputStream socket)] (wrap (: (TCP IO) - (structure (def: (read size) - (do (error.with io.monad) - [#let [data (binary.create size)] - bytes-read (InputStream::read data +0 (.int size) input)] - (wrap [(.nat bytes-read) - data]))) + (structure (def: read + (//.can-read + (function (read size) + (do (error.with io.monad) + [#let [data (binary.create size)] + bytes-read (InputStream::read data +0 (.int size) input)] + (wrap [(.nat bytes-read) + data]))))) - (def: (write data) - (do (error.with io.monad) - [_ (OutputStream::write data +0 (.int (binary.size data)) - output)] - (Flushable::flush output))) - - (def: (close _) - (do (error.with io.monad) - [_ (AutoCloseable::close input) - _ (AutoCloseable::close output)] - (AutoCloseable::close socket)))))))) + (def: write + (//.can-write + (function (write data) + (do (error.with io.monad) + [_ (OutputStream::write data +0 (.int (binary.size data)) + output)] + (Flushable::flush output))))) + + (def: close + (//.can-close + (function (close _) + (do (error.with io.monad) + [_ (AutoCloseable::close input) + _ (AutoCloseable::close output)] + (AutoCloseable::close socket)))))))))) (def: #export (client address port) (-> //.Address //.Port (IO (Error (TCP IO)))) @@ -91,17 +101,17 @@ (io.io (tcp socket)))) (def: #export (server port) - (-> //.Port (IO (Error [(Promise Any) - (frp.Channel (TCP IO))]))) + (-> //.Port (IO (Error [(Resolver Any) + (Channel (TCP IO))]))) (do (error.with io.monad) [server (ServerSocket::new (.int port)) - #let [close-signal (: (Promise Any) - (promise #.None)) + #let [[close-signal close-resolver] (: [(Promise Any) (Resolver Any)] + (promise.promise [])) _ (promise.await (function (_ _) (AutoCloseable::close server)) close-signal) - output (: (frp.Channel (TCP IO)) - (frp.channel [])) + [output sink] (: [(Channel (TCP IO)) (Sink (TCP IO))] + (frp.channel [])) _ (: (Promise Any) (promise.future (loop [_ []] @@ -115,6 +125,6 @@ (#error.Success client) (do @ - [_ (frp.publish output client)] + [_ (:: sink feed client)] (recur [])))))))]] - (wrap [close-signal output]))))})) + (wrap [close-resolver output]))))})) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 833b72e08..f7228aed3 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -4,7 +4,9 @@ monad ["ex" exception (#+ exception:)] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise)]] + [security + ["!" capability]]] [data ["." error (#+ Error)] ["." maybe] @@ -64,10 +66,12 @@ (def: #export (async udp) (-> (UDP IO) (UDP Promise)) - (`` (structure (~~ (do-template [] - [(def: (|>> (:: udp ) promise.future))] + (`` (structure (~~ (do-template [ ] + [(def: ( (|>> (!.use (:: udp )) promise.future)))] - [read] [write] [close]))))) + [read //.can-read] + [write //.can-write] + [close //.can-close]))))) (`` (for {(~~ (static host.jvm)) (as-is (def: (resolve address) @@ -82,34 +86,40 @@ (def: (udp socket) (-> DatagramSocket (UDP IO)) - (structure (def: (read size) - (let [data (binary.create size) - packet (DatagramPacket::new|receive data +0 (.int size))] - (do (error.with io.monad) - [_ (DatagramSocket::receive packet socket) - #let [bytes-read (.nat (DatagramPacket::getLength packet))]] - (wrap [bytes-read - {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) - #//.port (.nat (DatagramPacket::getPort packet))} - data])))) - - (def: (write [location data]) - (do (error.with io.monad) - [address (resolve (get@ #//.address location))] - (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location))) - socket))) - - (def: (close _) - (AutoCloseable::close socket)))) + (structure (def: read + (//.can-read + (function (read size) + (let [data (binary.create size) + packet (DatagramPacket::new|receive data +0 (.int size))] + (do (error.with io.monad) + [_ (DatagramSocket::receive packet socket) + #let [bytes-read (.nat (DatagramPacket::getLength packet))]] + (wrap [bytes-read + {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) + #//.port (.nat (DatagramPacket::getPort packet))} + data])))))) + + (def: write + (//.can-write + (function (write [location data]) + (do (error.with io.monad) + [address (resolve (get@ #//.address location))] + (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location))) + socket))))) + + (def: close + (//.can-close + (function (close _) + (AutoCloseable::close socket)))))) (def: #export client (IO (Error (UDP IO))) (|> (DatagramSocket::new|client) - (:: (error.with io.monad) map udp))) + (:: (error.with io.monad) map ..udp))) (def: #export server (-> //.Port (IO (Error (UDP IO)))) (|>> .int DatagramSocket::new|server - (:: (error.with io.monad) map udp))) + (:: (error.with io.monad) map ..udp))) )})) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 191a664ce..d0dc4f257 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -119,6 +119,7 @@ ["#." math] ["#." time] ["#." type] + ["#." world] ["#." host ["#/." jvm]]] ## [control @@ -142,12 +143,6 @@ ## ["_.S" structure] ## ["_.S" case] ## ["_.S" function]]]]] - ## [world - ## [binary (#+)] - ## [file (#+)] - ## [net - ## [tcp (#+)] - ## [udp (#+)]]] )) (def: identity @@ -372,8 +367,8 @@ /math.test) (<| (_.context "/time") /time.test) - (<| (_.context "/type") - /type.test) + /type.test + /world.test (<| (_.context "/host Host-platform interoperation") ($_ _.and /host.test diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux new file mode 100644 index 000000000..b23b29dbe --- /dev/null +++ b/stdlib/source/test/lux/world.lux @@ -0,0 +1,19 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." binary] + ["#." file] + ["#." net #_ + ["#/." tcp] + ["#/." udp]] + ]) + +(def: #export test + Test + ($_ _.and + /binary.test + /file.test + /net/tcp.test + /net/udp.test + )) diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux index ec4da0d11..2f347c50d 100644 --- a/stdlib/source/test/lux/world/binary.lux +++ b/stdlib/source/test/lux/world/binary.lux @@ -1,22 +1,21 @@ (.module: [lux #* - [control - ["." monad (#+ do)]] + data/text/format + ["r" math/random (#+ Random)] + ["_" test (#+ Test)] + [control ["." monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence]]}] [data ["." error (#+ Error)] - ["." number - ["." i64]] + [number + ["." i64] + ["." nat]] [collection - ["." list]]] - [world - ["/" binary]] - [math - ["r" random]]] - lux/test - [test - [lux - [control - ["_eq" equivalence]]]]) + ["." list]]]] + {1 + ["." / (#+ Binary)]}) (def: (succeed result) (-> (Error Bit) Bit) @@ -28,7 +27,7 @@ output)) (def: #export (binary size) - (-> Nat (r.Random /.Binary)) + (-> Nat (Random Binary)) (let [output (/.create size)] (loop [idx 0] (if (n/< size idx) @@ -39,7 +38,7 @@ (:: r.monad wrap output))))) (def: (bits-io bytes read write value) - (-> Nat (-> Nat /.Binary (Error Nat)) (-> Nat Nat /.Binary (Error Any)) Nat Bit) + (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit) (let [binary (/.create 8) bits (n/* 8 bytes) capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))] @@ -49,9 +48,10 @@ output (read 0 binary)] (wrap (n/= capped-value output)))))) -(context: "Binary." - (<| (times 100) - (do @ +(def: #export test + Test + (<| (_.context (%name (name-of /._))) + (do r.monad [#let [gen-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 8))))] binary-size gen-size random-binary (binary binary-size) @@ -59,30 +59,29 @@ #let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))] [from to] (r.and gen-idx gen-idx) #let [[from to] [(n/min from to) (n/max from to)]]] - ($_ seq - ## TODO: De-comment... - ## (_eq.spec /.equivalence (:: @ map binary gen-size)) - (test "Can get size of binary." - (|> random-binary /.size (n/= binary-size))) - (test "Can read/write 8-bit values." - (bits-io 1 /.read/8 /.write/8 value)) - (test "Can read/write 16-bit values." - (bits-io 2 /.read/16 /.write/16 value)) - (test "Can read/write 32-bit values." - (bits-io 4 /.read/32 /.write/32 value)) - (test "Can read/write 64-bit values." - (bits-io 8 /.read/64 /.write/64 value)) - (test "Can slice binaries." - (let [slice-size (|> to (n/- from) inc) - random-slice (error.assume (/.slice from to random-binary)) - idxs (list.n/range 0 (dec slice-size)) - reader (function (_ binary idx) (/.read/8 idx binary))] - (and (n/= slice-size (/.size random-slice)) - (case [(monad.map error.monad (reader random-slice) idxs) - (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] - [(#error.Success slice-vals) (#error.Success binary-vals)] - (:: (list.equivalence number.nat-equivalence) = slice-vals binary-vals) + ($_ _.and + ($equivalence.spec /.equivalence (binary binary-size)) + (_.test "Can get size of binary." + (|> random-binary /.size (n/= binary-size))) + (_.test "Can read/write 8-bit values." + (bits-io 1 /.read/8 /.write/8 value)) + (_.test "Can read/write 16-bit values." + (bits-io 2 /.read/16 /.write/16 value)) + (_.test "Can read/write 32-bit values." + (bits-io 4 /.read/32 /.write/32 value)) + (_.test "Can read/write 64-bit values." + (bits-io 8 /.read/64 /.write/64 value)) + (_.test "Can slice binaries." + (let [slice-size (|> to (n/- from) inc) + random-slice (error.assume (/.slice from to random-binary)) + idxs (list.n/range 0 (dec slice-size)) + reader (function (_ binary idx) (/.read/8 idx binary))] + (and (n/= slice-size (/.size random-slice)) + (case [(monad.map error.monad (reader random-slice) idxs) + (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] + [(#error.Success slice-vals) (#error.Success binary-vals)] + (:: (list.equivalence nat.equivalence) = slice-vals binary-vals) - _ - #0)))) + _ + #0)))) )))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index deed8dbd2..e27add632 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -1,26 +1,29 @@ (.module: [lux #* - ["." io (#+ IO)] + data/text/format + ["r" math/random (#+ Random) ("#@." monad)] + ["_" test (#+ Test)] [control - [monad (#+ do)]] - [concurrency - ["." promise]] + ["." monad (#+ do)] + [concurrency + ["." promise]] + [security + ["!" capability]]] + ["." io (#+ IO)] [data ["." error (#+ Error)] - ["." number] - ["." text - format] + ["." text] + [number + ["." int]] [collection ["." list]]] [time ["." instant] ["." duration]] [world - ["@" file (#+ Path File)] - ["." binary (#+ Binary)]] - [math - ["r" random ("#;." monad)]]] - lux/test + ["." binary (#+ Binary)]]] + {1 + ["." / (#+ Path File)]} [// ["_." binary]]) @@ -30,163 +33,166 @@ (def: (creation-and-deletion number) (-> Nat Test) - (r;wrap (do promise.monad + (r@wrap (do promise.monad [#let [path (format "temp_file_" (%n number))] result (promise.future - (do (error.ErrorT io.monad) + (do (error.with io.monad) [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.monad @.system path)))] + (error.lift io.monad (/.exists? io.monad /.system path)))] pre! check-existence! - file (:: @.system create-file path) + file (!.use (:: /.system create-file) path) post! check-existence! - _ (:: file delete []) + _ (!.use (:: file delete) []) remains? check-existence!] (wrap (and (not pre!) post! (not remains?)))))] - (assert "Can create/delete files." - (error.default #0 result))))) + (_.assert "Can create/delete files." + (error.default #0 result))))) (def: (read-and-write number data) (-> Nat Binary Test) - (r;wrap (do promise.monad + (r@wrap (do promise.monad [#let [path (format "temp_file_" (%n number))] result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write data) - content (:: file content []) - _ (:: file delete [])] + (do (error.with io.monad) + [file (!.use (:: /.system create-file) path) + _ (!.use (:: file over-write) data) + content (!.use (:: file content) []) + _ (!.use (:: file delete) [])] (wrap (:: binary.equivalence = data content))))] - (assert "Can write/read files." - (error.default #0 result))))) + (_.assert "Can write/read files." + (error.default #0 result))))) -(context: "File system." - (do @ - [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - dataL (_binary.binary file-size) - dataR (_binary.binary file-size) - new-modified (|> r.int (:: @ map (|>> (:: number.number abs) - truncate-millis - duration.from-millis - instant.absolute)))] - ($_ seq - (creation-and-deletion 0) - (read-and-write 1 dataL) - (wrap (do promise.monad - [#let [path "temp_file_2"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - read-size (:: file size []) - _ (:: file delete [])] - (wrap (n/= file-size read-size))))] - (assert "Can read file size." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_file_3"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - _ (:: file append dataR) - content (:: file content []) - read-size (:: file size []) - _ (:: file delete [])] - (wrap (and (n/= (n/* 2 file-size) read-size) - (:: binary.equivalence = - dataL - (error.assume (binary.slice 0 (dec file-size) content))) - (:: binary.equivalence = - dataR - (error.assume (binary.slice file-size (dec read-size) content)))))))] - (assert "Can append to files." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_dir_4"] - result (promise.future - (do (error.ErrorT io.monad) - [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.monad @.system path)))] - pre! check-existence! - dir (:: @.system create-directory path) - post! check-existence! - _ (:: dir discard []) - remains? check-existence!] - (wrap (and (not pre!) - post! - (not remains?)))))] - (assert "Can create/delete directories." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [file-path "temp_file_5" - dir-path "temp_dir_5"] - result (promise.future - (do (error.ErrorT io.monad) - [dir (:: @.system create-directory dir-path) - file (:: @.system create-file (format dir-path "/" file-path)) - _ (:: file over-write dataL) - read-size (:: file size []) - _ (:: file delete []) - _ (:: dir discard [])] - (wrap (n/= file-size read-size))))] - (assert "Can create files inside of directories." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [file-path "temp_file_6" - dir-path "temp_dir_6" - inner-dir-path "inner_temp_dir_6"] - result (promise.future - (do (error.ErrorT io.monad) - [dir (:: @.system create-directory dir-path) - pre-files (:: dir files []) - pre-directories (:: dir directories []) - - file (:: @.system create-file (format dir-path "/" file-path)) - inner-dir (:: @.system create-directory (format dir-path "/" inner-dir-path)) - post-files (:: dir files []) - post-directories (:: dir directories []) - - _ (:: file delete []) - _ (:: inner-dir discard []) - _ (:: dir discard [])] - (wrap (and (and (n/= 0 (list.size pre-files)) - (n/= 0 (list.size pre-directories))) - (and (n/= 1 (list.size post-files)) - (n/= 1 (list.size post-directories)))))))] - (assert "Can list files/directories inside a directory." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_file_7"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - _ (:: file modify new-modified) - old-modified (:: file last-modified []) - _ (:: file delete [])] - (wrap (:: instant.equivalence = new-modified old-modified))))] - (assert "Can change the time of last modification." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path0 (format "temp_file_8+0") - path1 (format "temp_file_8+1")] - result (promise.future - (do (error.ErrorT io.monad) - [#let [check-existence! (: (-> Path (IO (Error Bit))) - (|>> (@.exists? io.monad @.system) io.from-io))] - file0 (:: @.system create-file path0) - _ (:: file0 over-write dataL) - pre! (check-existence! path0) - file1 (: (IO (Error (File IO))) ## TODO: Remove : - (:: file0 move path1)) - post! (check-existence! path0) - confirmed? (check-existence! path1) - _ (:: file1 delete [])] - (wrap (and pre! - (not post!) - confirmed?))))] - (assert "Can move a file from one path to another." - (error.default #0 result)))) - ))) +(def: #export test + Test + (<| (_.context (%name (name-of /._))) + (do r.monad + [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + dataL (_binary.binary file-size) + dataR (_binary.binary file-size) + new-modified (|> r.int (:: @ map (|>> (:: int.number abs) + truncate-millis + duration.from-millis + instant.absolute)))] + ($_ _.and + (creation-and-deletion 0) + (read-and-write 1 dataL) + (wrap (do promise.monad + [#let [path "temp_file_2"] + result (promise.future + (do (error.with io.monad) + [file (!.use (:: /.system create-file) path) + _ (!.use (:: file over-write) dataL) + read-size (!.use (:: file size) []) + _ (!.use (:: file delete) [])] + (wrap (n/= file-size read-size))))] + (_.assert "Can read file size." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_file_3"] + result (promise.future + (do (error.with io.monad) + [file (!.use (:: /.system create-file) path) + _ (!.use (:: file over-write) dataL) + _ (!.use (:: file append) dataR) + content (!.use (:: file content) []) + read-size (!.use (:: file size) []) + _ (!.use (:: file delete) [])] + (wrap (and (n/= (n/* 2 file-size) read-size) + (:: binary.equivalence = + dataL + (error.assume (binary.slice 0 (dec file-size) content))) + (:: binary.equivalence = + dataR + (error.assume (binary.slice file-size (dec read-size) content)))))))] + (_.assert "Can append to files." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_dir_4"] + result (promise.future + (do (error.with io.monad) + [#let [check-existence! (: (IO (Error Bit)) + (error.lift io.monad (/.exists? io.monad /.system path)))] + pre! check-existence! + dir (!.use (:: /.system create-directory) path) + post! check-existence! + _ (!.use (:: dir discard) []) + remains? check-existence!] + (wrap (and (not pre!) + post! + (not remains?)))))] + (_.assert "Can create/delete directories." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [file-path "temp_file_5" + dir-path "temp_dir_5"] + result (promise.future + (do (error.with io.monad) + [dir (!.use (:: /.system create-directory) dir-path) + file (!.use (:: /.system create-file) (format dir-path "/" file-path)) + _ (!.use (:: file over-write) dataL) + read-size (!.use (:: file size) []) + _ (!.use (:: file delete) []) + _ (!.use (:: dir discard) [])] + (wrap (n/= file-size read-size))))] + (_.assert "Can create files inside of directories." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [file-path "temp_file_6" + dir-path "temp_dir_6" + inner-dir-path "inner_temp_dir_6"] + result (promise.future + (do (error.with io.monad) + [dir (!.use (:: /.system create-directory) dir-path) + pre-files (!.use (:: dir files) []) + pre-directories (!.use (:: dir directories) []) + + file (!.use (:: /.system create-file) (format dir-path "/" file-path)) + inner-dir (!.use (:: /.system create-directory) (format dir-path "/" inner-dir-path)) + post-files (!.use (:: dir files) []) + post-directories (!.use (:: dir directories) []) + + _ (!.use (:: file delete) []) + _ (!.use (:: inner-dir discard) []) + _ (!.use (:: dir discard) [])] + (wrap (and (and (n/= 0 (list.size pre-files)) + (n/= 0 (list.size pre-directories))) + (and (n/= 1 (list.size post-files)) + (n/= 1 (list.size post-directories)))))))] + (_.assert "Can list files/directories inside a directory." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path "temp_file_7"] + result (promise.future + (do (error.with io.monad) + [file (!.use (:: /.system create-file) path) + _ (!.use (:: file over-write) dataL) + _ (!.use (:: file modify) new-modified) + old-modified (!.use (:: file last-modified) []) + _ (!.use (:: file delete) [])] + (wrap (:: instant.equivalence = new-modified old-modified))))] + (_.assert "Can change the time of last modification." + (error.default #0 result)))) + (wrap (do promise.monad + [#let [path0 (format "temp_file_8+0") + path1 (format "temp_file_8+1")] + result (promise.future + (do (error.with io.monad) + [#let [check-existence! (: (-> Path (IO (Error Bit))) + (|>> (/.exists? io.monad /.system) + (error.lift io.monad)))] + file0 (!.use (:: /.system create-file) path0) + _ (!.use (:: file0 over-write) dataL) + pre! (check-existence! path0) + file1 (: (IO (Error (File IO))) ## TODO: Remove : + (!.use (:: file0 move) path1)) + post! (check-existence! path0) + confirmed? (check-existence! path1) + _ (!.use (:: file1 delete) [])] + (wrap (and pre! + (not post!) + confirmed?))))] + (_.assert "Can move a file from one path to another." + (error.default #0 result)))) + )))) diff --git a/stdlib/source/test/lux/world/net/tcp.lux b/stdlib/source/test/lux/world/net/tcp.lux index 43a304a58..f7ec2eaef 100644 --- a/stdlib/source/test/lux/world/net/tcp.lux +++ b/stdlib/source/test/lux/world/net/tcp.lux @@ -1,25 +1,25 @@ (.module: [lux #* - ["." io] + data/text/format + ["r" math/random (#+ Random)] + ["_" test (#+ Test)] + [control ["." monad (#+ do)]] + ["." io (#+ IO)] [control - [monad (#+ do)] ["ex" exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise Resolver)] + ["." frp ("#@." functor)]] [security - ["." taint]]] - [concurrency - ["." promise (#+ Promise promise)] - ["." frp ("#;." functor)]] + ["!" capability]]] [data - ["." error] - ["." text - format]] + ["." error (#+ Error)] + ["." text]] [world ["." binary] - ["." net - ["@" tcp]]] - [math - ["r" random]]] - lux/test + ["." net]]] + {1 + ["." /]} [/// ["_." binary]]) @@ -32,40 +32,42 @@ (|>> (n/% 1000) (n/+ 8000))))) -(context: "TCP networking." - (do @ - [port ..port - size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - from (_binary.binary size) - to (_binary.binary size)] - ($_ seq - (wrap (do promise.monad - [#let [from-worked? (: (Promise Bit) - (promise #.Nil))] - result (promise.future - (do io.monad - [[server-close server] (@.server port) - #let [_ (frp;map (function (_ client) - (promise.future - (do @ - [[trasmission-size transmission] (:: client read size) - #let [_ (io.run (promise.resolve (and (n/= size trasmission-size) - (:: binary.equivalence = from (taint.trust transmission))) - from-worked?))]] - (:: client write to)))) - server)] - client (@.client localhost port) - _ (:: client write from) - #################### - [trasmission-size transmission] (:: client read size) - #let [to-worked? (and (n/= size trasmission-size) - (:: binary.equivalence = to (taint.trust transmission)))] - #################### - _ (:: client close []) - _ (io.from-io (promise.resolve [] server-close))] - (wrap to-worked?))) - from-worked? from-worked?] - (assert "Can communicate between client and server." - (and from-worked? - (error.default #0 result))))) - ))) +(def: #export test + Test + (<| (_.context (%name (name-of /._))) + (do r.monad + [port ..port + size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + from (_binary.binary size) + to (_binary.binary size)] + ($_ _.and + (wrap (do promise.monad + [#let [[from-worked? from-worked!] (: [(Promise Bit) (Resolver Bit)] + (promise.promise []))] + result (promise.future + (do (error.with io.monad) + [[close! server] (/.server port) + #let [_ (frp@map (function (_ client) + (promise.future + (do @ + [[trasmission-size transmission] (!.use (:: client read) size) + #let [_ (io.run (from-worked! (and (n/= size trasmission-size) + (:: binary.equivalence = from transmission))))]] + (!.use (:: client write) to)))) + server)] + client (/.client localhost port) + _ (!.use (:: client write) from) + #################### + [trasmission-size transmission] (!.use (:: client read) size) + #let [to-worked? (and (n/= size trasmission-size) + (:: binary.equivalence = to transmission))] + #################### + _ (!.use (:: client close) []) + _ (: (IO (Error Bit)) + (error.lift io.monad (close! [])))] + (wrap to-worked?))) + from-worked? from-worked?] + (_.assert "Can communicate between client and server." + (and from-worked? + (error.default #0 result))))) + )))) diff --git a/stdlib/source/test/lux/world/net/udp.lux b/stdlib/source/test/lux/world/net/udp.lux index d3d2531f9..1740c861c 100644 --- a/stdlib/source/test/lux/world/net/udp.lux +++ b/stdlib/source/test/lux/world/net/udp.lux @@ -1,21 +1,23 @@ (.module: [lux #* + data/text/format + ["r" math/random (#+ Random)] + ["_" test (#+ Test)] [control - [monad (#+ do)]] - [concurrency - ["." promise]] + ["." monad (#+ do)] + [concurrency + ["." promise]] + [security + ["!" capability]]] [data ["." error] - ["." text - format]] + ["." text]] ["." io] [world ["." binary] - ["." net - ["@" udp]]] - [math - ["r" random]]] - lux/test + ["." net]]] + {1 + ["." /]} [/// ["_." binary]]) @@ -27,36 +29,38 @@ (|>> (n/% 1000) (n/+ 8000))))) -(context: "UDP networking." - (do @ - [port ..port - size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - from (_binary.binary size) - to (_binary.binary size)] - ($_ seq - (wrap (do promise.monad - [result (promise.future - (do io.monad - [server (@.server port) - client @.client - #################### - _ (:: client write [[localhost port] from]) - [bytes-from [from-address from-port] temp] (:: server read size) - #let [from-worked? (and (n/= size bytes-from) - (:: binary.equivalence = from temp))] - #################### - _ (:: server write [[from-address from-port] to]) - [bytes-to [to-address to-port] temp] (:: client read size) - #let [to-worked? (and (n/= size bytes-to) - (:: binary.equivalence = to temp) - (n/= port to-port))] - #################### - _ (:: client close []) - _ (:: server close [])] - ## (wrap false) - (wrap (and from-worked? - to-worked?)) - ))] - (assert "Can communicate between client and server." - (error.default #0 result)))) - ))) +(def: #export test + Test + (<| (_.context (%name (name-of /._))) + (do r.monad + [port ..port + size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + from (_binary.binary size) + to (_binary.binary size)] + ($_ _.and + (wrap (do promise.monad + [result (promise.future + (do (error.with io.monad) + [server (/.server port) + client /.client + #################### + _ (!.use (:: client write) [[localhost port] from]) + [bytes-from [from-address from-port] temp] (!.use (:: server read) size) + #let [from-worked? (and (n/= size bytes-from) + (:: binary.equivalence = from temp))] + #################### + _ (!.use (:: server write) [[from-address from-port] to]) + [bytes-to [to-address to-port] temp] (!.use (:: client read) size) + #let [to-worked? (and (n/= size bytes-to) + (:: binary.equivalence = to temp) + (n/= port to-port))] + #################### + _ (!.use (:: client close) []) + _ (!.use (:: server close) [])] + ## (wrap false) + (wrap (and from-worked? + to-worked?)) + ))] + (_.assert "Can communicate between client and server." + (error.default #0 result)))) + )))) -- cgit v1.2.3