WorkspaceTests.hs (3702B)
1 module WorkspaceTests (workspaceTests) where 2 3 import Workspace 4 import Control.Exception (IOException, try) 5 import qualified Data.ByteString as BS 6 import qualified Data.Map.Strict as M 7 import System.Directory 8 import System.FilePath ((</>)) 9 import System.IO.Temp (withSystemTempDirectory) 10 import Test.Tasty 11 import Test.Tasty.HUnit 12 13 workspaceTests :: TestTree 14 workspaceTests = testGroup "workspace source locations" 15 [ testCase "strict declarations" $ do 16 parseWorkspace "tricu.workspace.v1\nmath\tlib/math.tri\n" @?= Right [("math","lib/math.tri")] 17 mapM_ (\bytes -> case parseWorkspace bytes of 18 Left _ -> pure () 19 Right _ -> assertFailure "accepted invalid declaration") 20 [ "tricu.workspace.v1\nmath\ta.tri\nMath\tb.tri\n" 21 , "tricu.workspace.v1\nmath\ta.tri" 22 , "tricu.workspace.v1\nmath\t/a.tri\n" 23 , "tricu.workspace.v1\n../math\ta.tri\n" 24 , "tricu.workspace.v1\r\n" 25 , "tricu.workspace.v1\n\n" 26 , "tricu.workspace.v1\nx\ta.tri\textra\n" 27 , BS.pack [255] 28 ] 29 , testCase "parent discovery, exact source copies, cleanup, and nearest declaration" $ fresh $ \root -> do 30 let app = root </> "app"; lib = root </> "lib" 31 createDirectory app 32 createDirectory lib 33 BS.writeFile (app </> "main.tri") "!import math as M\n!export main\nmain = M.answer\n" 34 BS.writeFile (lib </> "number.tri") "!export answer\nanswer = 42\n" 35 BS.writeFile (root </> "tricu.workspace") "tricu.workspace.v1\nmath\tlib/number.tri\n" 36 sources <- workspaceSources (app </> "main.tri") 37 M.keys sources @?= ["main", "math"] 38 temp <- withWorkspace (app </> "main.tri") $ \dir -> do 39 BS.readFile (dir </> "math.tri") >>= (@?= "!export answer\nanswer = 42\n") 40 pure dir 41 doesPathExist temp >>= (@?= False) 42 BS.writeFile (app </> "tricu.workspace") "tricu.workspace.v1\n" 43 workspaceSources (app </> "main.tri") >>= ((@?= ["main"]) . M.keys) 44 , testCase "no silent local shadowing or missing mapped sources" $ fresh $ \root -> do 45 BS.writeFile (root </> "main.tri") "!export main\nmain = 1\n" 46 BS.writeFile (root </> "other.tri") "!export main\nmain = 2\n" 47 BS.writeFile (root </> "tricu.workspace") "tricu.workspace.v1\nmain\tother.tri\n" 48 rejects (workspaceSources (root </> "main.tri")) 49 BS.writeFile (root </> "tricu.workspace") "tricu.workspace.v1\nmissing\tabsent.tri\n" 50 rejects (workspaceSources (root </> "main.tri")) 51 , testCase "mapping the same sibling is not ambiguous" $ fresh $ \root -> do 52 BS.writeFile (root </> "main.tri") "!export main\nmain = 1\n" 53 BS.writeFile (root </> "tricu.workspace") "tricu.workspace.v1\nmain\tmain.tri\n" 54 workspaceSources (root </> "main.tri") >>= ((@?= ["main"]) . M.keys) 55 , testCase "direct source symlinks are rejected" $ fresh $ \root -> do 56 BS.writeFile (root </> "target.tri") "!export main\nmain = 1\n" 57 createFileLink (root </> "target.tri") (root </> "main.tri") 58 rejects (workspaceSources (root </> "main.tri")) 59 , testCase "temporary snapshot removed on failure" $ fresh $ \root -> do 60 BS.writeFile (root </> "main.tri") "!export main\nmain = 1\n" 61 let marker = root </> "location" 62 rejects $ withWorkspace (root </> "main.tri") $ \dir -> do 63 writeFile marker dir 64 fail "compiler failure" :: IO () 65 readFile marker >>= doesPathExist >>= (@?= False) 66 ] 67 where 68 fresh = withSystemTempDirectory "tricu-workspace-test" 69 rejects action = do 70 result <- try (action >> pure ()) :: IO (Either IOException ()) 71 case result of 72 Left _ -> pure () 73 Right _ -> assertFailure "expected workspace error"