tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

IOContextTests.hs (2340B)

      1 module IOContextTests (ioContextTests) where
      2 import qualified IO.Context as C
      3 import qualified IO.Driver as V
      4 import qualified IO.Resources as R
      5 import qualified IO.Protocol as P
      6 import Runtime (T(..),ofString,ofList,ofNumber)
      7 import System.Directory (getCurrentDirectory)
      8 import System.Environment (lookupEnv)
      9 import Test.Tasty
     10 import Test.Tasty.HUnit
     11 
     12 request op payload = Fork (ofNumber 10) (Fork (ofString "process") (Fork (ofNumber 1) (Fork (ofString op) payload)))
     13 ok value = Fork (Stem Leaf) (Fork value Leaf)
     14 check action expected = V.runDetailed action >>= \outcome -> case outcome of
     15   V.Completed value -> value @?= expected
     16   _ -> assertFailure (show outcome)
     17 ioContextTests = testGroup "IO read-only process context"
     18   [ testCase "cwd is the actual host directory" $ do
     19       expected <- getCurrentDirectory
     20       check (request "working-directory" Leaf) (ok (ofString expected))
     21   , testCase "environment query is distinct from lexical application configuration" $ do
     22       expected <- lookupEnv "PATH"
     23       actual <- C.environmentVariable "PATH"
     24       actual @?= traverse (C.boundedText "environment-variable") expected
     25   , testCase "invalid names and payloads reject ordinarily" $ do
     26       mapM_ (\name -> C.environmentVariable name >>= \result -> case result of
     27         Left _ -> pure (); _ -> assertFailure "invalid name accepted") ["","A=B","A\0B",replicate 4097 'x']
     28       let bad op = Fork Leaf (Fork (ofList (map ofString ["invalid-argument","process/"++op,"","none"])) Leaf)
     29       check (request "working-directory" (Stem Leaf)) (bad "working-directory")
     30       check (request "environment-variable" (Stem Leaf)) (bad "environment-variable")
     31   , testCase "result bounds and strict scalars do not truncate or normalize" $ do
     32       C.boundedText "test" "λ\n\xFEFF" @?= Right "λ\n\xFEFF"
     33       C.boundedText "test" (replicate 4096 'x') @?= Right (replicate 4096 'x')
     34       mapM_ (\value -> case C.boundedText "test" value of
     35         Left _ -> pure (); _ -> assertFailure "invalid context text accepted") [replicate 4097 'x',"\xD800","\0"]
     36   , testCase "context inspection does not execute or demand payloads" $ do
     37       P.inspectAction (request "working-directory" (error "demanded")) @?=
     38         Right (ofList [ofString "facility",ofString "process",ofNumber 1,ofString "working-directory",ofString "available"])
     39   ]