From 56fa0ab84c1112ea297c46814e580ca8d11b101e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 10 Aug 2020 02:29:18 -0400
Subject: Improved naming when evaluating code on the host platform.

---
 stdlib/source/test/lux/control.lux                 |  4 +-
 .../test/lux/control/security/capability.lux       | 45 ++++++++++++++++++++++
 stdlib/source/test/lux/world/file.lux              |  5 ++-
 3 files changed, 51 insertions(+), 3 deletions(-)
 create mode 100644 stdlib/source/test/lux/control/security/capability.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index b3e55e901..50e737e98 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -34,7 +34,8 @@
    ["#." region]
    ["#." remember]
    [security
-    ["#." policy]]
+    ["#." policy]
+    ["#." capability]]
    ["#." state]
    ["#." thread]
    ["#." try]
@@ -81,6 +82,7 @@
   Test
   ($_ _.and
       /policy.test
+      /capability.test
       ))
 
 (def: #export test
diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux
new file mode 100644
index 000000000..b102c6a33
--- /dev/null
+++ b/stdlib/source/test/lux/control/security/capability.lux
@@ -0,0 +1,45 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    [concurrency
+     ["." promise]]]
+   [data
+    [number
+     ["n" nat]]]
+   [math
+    ["." random]]]
+  {1
+   ["." /]})
+
+(/.capability: (Can-Shift a)
+  (can-shift [a Nat] [a Nat]))
+
+(/.capability: Can-IO
+  (can-io [] (IO Nat)))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do random.monad
+        [shift random.nat
+         base random.nat
+         #let [expected (n.+ shift base)]
+         pass-through (random.ascii 1)]
+        (_.with-cover [/.Capability]
+          ($_ _.and
+              (_.cover [/.capability: /.use]
+                       (let [capability (..can-shift (function (_ [no-op raw])
+                                                       [no-op (n.+ shift raw)]))
+                             [untouched actual] (/.use capability [pass-through base])]
+                         (and (is? pass-through untouched)
+                              (n.= expected actual))))
+              (wrap (let [capability (..can-io (function (_ _) (io.io expected)))]
+                      (do promise.monad
+                        [actual (/.use (/.async capability) [])]
+                        (_.claim [/.async]
+                                 (n.= expected actual)))))
+              )))))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index 5f8d03273..0fd4d76f3 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -73,6 +73,7 @@
          dataL (_binary.binary file-size)
          dataR (_binary.binary file-size)
          new-modified (|> r.int (:: @ map (|>> i.abs
+                                               (i.% +10,000,000,000,000)
                                                truncate-millis
                                                duration.from-millis
                                                instant.absolute)))]
@@ -170,9 +171,9 @@
                                [file (!.use (:: /.system create-file) path)
                                 _ (!.use (:: file over-write) dataL)
                                 _ (!.use (:: file modify) new-modified)
-                                old-modified (!.use (:: file last-modified) [])
+                                current-modified (!.use (:: file last-modified) [])
                                 _ (!.use (:: file delete) [])]
-                               (wrap (:: instant.equivalence = new-modified old-modified))))]
+                               (wrap (:: instant.equivalence = new-modified current-modified))))]
                     (_.assert "Can change the time of last modification."
                               (try.default #0 result))))
             (wrap (do promise.monad
-- 
cgit v1.2.3