diff options
| -rw-r--r-- | src/Parser.hs | 1 | ||||
| -rw-r--r-- | src/Run.hs | 6 | ||||
| -rw-r--r-- | src/Run/Monad.hs | 1 | ||||
| -rw-r--r-- | src/Test.hs | 1 |
4 files changed, 7 insertions, 2 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index ed03f3f..c94e1e8 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -45,6 +45,7 @@ parseTestDefinition = label "test definition" $ toplevel ToplevelTest $ do } href <- L.indentLevel testName <- header + testModuleName <- gets testCurrentModuleName osymbol ":" <* eol <* scn ref <- L.indentGuard scn GT href @@ -32,6 +32,7 @@ import Data.Text qualified as T import Data.Typeable import System.Directory +import System.FilePath import System.Exit import System.IO.Error import System.Posix.Process @@ -58,7 +59,7 @@ import Test.Builtins runTest :: Output -> TestOptions -> GlobalDefs -> Test -> IO Bool runTest out opts gdefs test = do - let testDir = optTestDir opts + let testDir = optTestDir opts </> T.unpack (textModuleName (testModuleName test) <> "." <> testName test) when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e -> if isDoesNotExistError e then return () else ioError e exists <- doesPathExist testDir @@ -81,6 +82,7 @@ runTest out opts gdefs test = do { teOutput = out , teFailed = failedVar , teOptions = opts + , teTestDir = testDir , teNextObjId = objIdVar , teNextProcId = procIdVar , teProcesses = procVar @@ -302,7 +304,7 @@ runStep = \case withInternet :: (Network -> TestRun a) -> TestRun a withInternet inner = do - testDir <- asks $ optTestDir . teOptions . fst + testDir <- asks $ teTestDir . fst inet <- newInternet testDir flip finally (delInternet inet) $ do withNetwork (inetRoot inet) $ \net -> do diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index f4444e8..536038a 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -43,6 +43,7 @@ data TestEnv = TestEnv { teOutput :: Output , teFailed :: TVar (Maybe Failed) , teOptions :: TestOptions + , teTestDir :: FilePath , teNextObjId :: MVar Int , teNextProcId :: MVar Int , teProcesses :: MVar [ Process ] diff --git a/src/Test.hs b/src/Test.hs index 61f2e3d..e9aaaba 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -26,6 +26,7 @@ import Script.Shell data Test = Test { testName :: Text + , testModuleName :: ModuleName , testTags :: [ Expr Tag ] , testSteps :: Expr (TestStep ()) } |