julia.withPackages: improve test parallelism and logging

This commit is contained in:
Tom McLaughlin
2025-08-13 02:33:18 -07:00
parent 3274b12d48
commit 7dfc1692c0
@@ -12,8 +12,8 @@
module Main (main) where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson as A hiding (Options, defaultOptions)
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap as HM
@@ -24,12 +24,14 @@ import Data.Text as T hiding (count)
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import GHC.Generics
import Options.Applicative
import Options.Applicative hiding (info)
import System.Exit
import System.FilePath
import Test.Sandwich hiding (info)
import Test.Sandwich
import UnliftIO.Exception
import UnliftIO.MVar
import UnliftIO.Process
import UnliftIO.QSem
data Args = Args {
@@ -67,13 +69,15 @@ main = do
Left err -> throwIO $ userError ("Couldn't decode names and counts YAML file: " <> show err)
Right x -> pure x
runSandwichWithCommandLineArgs' defaultOptions argsParser $ do
runSandwichWithCommandLineArgs' defaultOptions argsParser $ parallel $ do
miscTests args
describe ("Building environments for top " <> show topN <> " Julia packages") $
parallelN parallelism $
forM_ (L.take topN namesAndCounts) $ \(NameAndCount {..}) ->
testExpr args name [i|#{juliaAttr}.withPackages ["#{name}"]|]
introduce "Introduce parallel semaphore" parallelSemaphore (liftIO $ newQSem parallelism) (const $ return ()) $
parallel $
forM_ (L.take topN namesAndCounts) $ \(NameAndCount {..}) ->
around "Claim semaphore" claimRunSlot $
testExpr args name [i|#{juliaAttr}.withPackages ["#{name}"]|]
miscTests :: Args -> SpecFree ctx IO ()
miscTests args@(Args {..}) = describe "Misc tests" $ do
@@ -89,6 +93,9 @@ miscTests args@(Args {..}) = describe "Misc tests" $ do
};
}) [ "HelloWorld" ]|]
describe "misc cases" $ do
testExpr args "Optimization" [iii|(#{juliaAttr}.withPackages) [ "Optimization" "OptimizationOptimJL" ]|]
-- * Low-level
testExpr :: Args -> Text -> String -> SpecFree ctx IO ()
@@ -98,7 +105,9 @@ testExpr _args name expr = do
let cp = proc "nix" ["build", "--impure", "--no-link", "--json", "--expr", [i|with import ../../../../. {}; #{expr}|]]
output <- readCreateProcessWithLogging cp ""
juliaPath <- case A.eitherDecode (BL8.pack output) of
Right (A.Array ((V.!? 0) -> Just (A.Object (aesonLookup "outputs" -> Just (A.Object (aesonLookup "out" -> Just (A.String t))))))) -> pure (JuliaPath ((T.unpack t) </> "bin" </> "julia"))
Right (A.Array ((V.!? 0) -> Just (A.Object (aesonLookup "outputs" -> Just (A.Object (aesonLookup "out" -> Just (A.String t))))))) -> do
info [i|built: #{t}|]
pure (JuliaPath ((T.unpack t) </> "bin" </> "julia"))
x -> expectationFailure ("Couldn't parse output: " <> show x)
getContext julia >>= flip modifyMVar_ (const $ return (Just juliaPath))
@@ -113,3 +122,8 @@ testExpr _args name expr = do
where
aesonLookup :: Text -> HM.KeyMap v -> Maybe v
aesonLookup = HM.lookup . A.fromText
claimRunSlot :: (HasParallelSemaphore ctx) => ExampleT ctx IO a -> ExampleT ctx IO ()
claimRunSlot f = do
s <- getContext parallelSemaphore
bracket_ (liftIO $ waitQSem s) (liftIO $ signalQSem s) (void f)