tricu

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

IODriverTests.hs (1599B)

      1 module IODriverTests (ioDriverTests) where
      2 
      3 import IODriver
      4 import Runtime
      5 import Control.Monad (forM_)
      6 import Test.Tasty
      7 import Test.Tasty.HUnit
      8 
      9 frame :: Integer -> T -> T
     10 frame version = Fork (ofString "tricuIO") . Fork (ofNumber version)
     11 
     12 ioDriverTests :: TestTree
     13 ioDriverTests = testGroup "Current IO protocol dispatch"
     14   [ testCase "only v2 executes; historical inspection is inert" $ do
     15       checkIOSentinel (frame 1 Leaf) @?= Right (1, Leaf)
     16       forM_ [0,1,3,99,65535] $ \version ->
     17         runIO (frame version (error "rejected protocol body demanded"))
     18           >>= (@?= Left "Unsupported tricuIO version")
     19   , testCase "all retired action numbers reject before their payloads" $
     20       forM_ [0..100] $ \tag ->
     21         runIO (frame 1 (Fork (ofNumber tag) (error "retired payload demanded")))
     22           >>= (@?= Left "Unsupported tricuIO version")
     23   , testCase "ordinary Result values are not terminal outcomes" $ do
     24       let value = Fork Leaf (Fork (ofString "ordinary failure") Leaf)
     25       runIO (frame 2 (Fork (ofNumber 0) value)) >>= (@?= Right value)
     26   , testCase "malformed versions reject without touching action" $ do
     27       forM_ [Stem Leaf, ofNumber 65536, Fork Leaf (Fork (Stem Leaf) (Fork Leaf Leaf))] $ \version ->
     28         runIO (Fork (ofString "tricuIO") (Fork version (error "invalid version body demanded")))
     29           >>= (@?= Left "invalid IO envelope version")
     30   , testCase "bare computations are not guessed or retried" $ do
     31       result <- runIO (Fork (ofNumber 0) Leaf)
     32       assertBool "bare computation rejected" (case result of Left _ -> True; _ -> False)
     33   ]