ddc-war 0.2.1.1 → 0.4.1.1
raw patch · 21 files changed
+463/−274 lines, 21 filesdep ~basedep ~containersdep ~directory
Dependency ranges changed: base, containers, directory, process, stm
Files
- DDC/War/Config.hs +4/−3
- DDC/War/Create.hs +7/−2
- DDC/War/Create/CreateDC.hs +97/−0
- DDC/War/Create/CreateDCE.hs +0/−87
- DDC/War/Create/CreateDSX.hs +46/−0
- DDC/War/Driver/Gang.hs +1/−2
- DDC/War/Interface/Controller.hs +3/−3
- DDC/War/Job.hs +12/−4
- DDC/War/Job/CompileDC.hs +159/−0
- DDC/War/Job/CompileDCE.hs +0/−125
- DDC/War/Job/CompileDS.hs +6/−4
- DDC/War/Job/CompileHS.hs +2/−1
- DDC/War/Job/Diff.hs +1/−1
- DDC/War/Job/RunDCX.hs +6/−3
- DDC/War/Job/RunDSX.hs +81/−0
- DDC/War/Option.hs +3/−0
- DDC/War/Task/Nightly.hs +10/−6
- DDC/War/Task/Test.hs +4/−2
- LICENSE +1/−15
- Main.hs +5/−4
- ddc-war.cabal +15/−12
DDC/War/Config.hs view
@@ -39,7 +39,7 @@ { T.specTestDirs = [] , T.specWays = [] , T.specThreads = 1- , T.specFormatPathWidth = 70+ , T.specFormatPathWidth = 80 , T.specInteractive = True , T.specResultsFileAll = Nothing , T.specResultsFileFailed = Nothing }@@ -52,12 +52,13 @@ , N.specRemoteSnapshotURL = "http://code.ouroborus.net/ddc/snapshot/ddc-head-latest.tgz" , N.specRemoteRepoURL = "http://code.ouroborus.net/ddc/ddc-head" , N.specBuildThreads = 1+ , N.specBuildFlavour = "distro" , N.specCleanup = False , N.specContinuous = Nothing , N.specNow = False , N.specLogUserHost = Just $ "overlord@deluge.ouroborus.net"- , N.specLogRemoteDir = Just $ "log/desire/ddc/head"- , N.specLogRemoteURL = Just $ "http://log.ouroborus.net/desire/ddc/head"+ , N.specLogRemoteDir = Nothing+ , N.specLogRemoteURL = Nothing , N.specMailer = Just $ B.MailerSendmail "sendmail" [] , N.specMailFrom = Just $ "DDC Buildbot <overlord@ouroborus.net>" , N.specMailTo = Just $ "disciple-cafe@googlegroups.com" }
DDC/War/Create.hs view
@@ -25,6 +25,9 @@ -- Test.dcx Run with ddci-core. -- Test.stdout.check Diff run stdout with this file. -- +-- Test.dsx Run with ddci-tetra.+-- Test.stdout.check Diff run stdout with this file.+-- module DDC.War.Create ( Way (..) , create)@@ -38,7 +41,8 @@ import qualified DDC.War.Create.CreateMainDS as CreateMainDS import qualified DDC.War.Create.CreateTestDS as CreateTestDS import qualified DDC.War.Create.CreateDCX as CreateDCX-import qualified DDC.War.Create.CreateDCE as CreateDCE+import qualified DDC.War.Create.CreateDSX as CreateDSX+import qualified DDC.War.Create.CreateDC as CreateDC -- | Create job chains based on this file.@@ -56,5 +60,6 @@ , CreateMainDS.create , CreateTestDS.create , CreateDCX.create- , CreateDCE.create ]]+ , CreateDSX.create+ , CreateDC.create ]]
+ DDC/War/Create/CreateDC.hs view
@@ -0,0 +1,97 @@+++module DDC.War.Create.CreateDC+ (create)+where+import DDC.War.Create.Way+import DDC.War.Driver+import System.FilePath+import DDC.War.Job ()+import Data.Set (Set)+import qualified DDC.War.Job.CompileDC as CompileDC+import qualified DDC.War.Job.RunExe as RunExe+import qualified DDC.War.Job.Diff as Diff+import qualified Data.Set as Set+++-- | Compile and run .dce files.+create :: Way -> Set FilePath -> FilePath -> Maybe Chain+create way allFiles filePath+ | takeFileName filePath == "Main.dcs"+ || takeFileName filePath == "Main.dcl"+ = let + sourceDir = takeDirectory filePath+ buildDir = sourceDir </> "war-" ++ wayName way+ testName = filePath++ mainSH = sourceDir </> "Main.sh"+ mainBin = buildDir </> "Main.bin"+ mainCompStdout = buildDir </> "Main.compile.stdout"+ mainCompStderr = buildDir </> "Main.compile.stderr"+ mainCompDiff = buildDir </> "Main.compile.stderr.diff"+ mainRunStdout = buildDir </> "Main.run.stdout"+ mainRunStderr = buildDir </> "Main.run.stderr"++ mainErrorCheck = sourceDir </> "Main.error.check"+ compShouldSucceed = not $ Set.member mainErrorCheck allFiles++ -- If this exists then expect the execuable to fail at runtime.+ mainRunErrorCheck = sourceDir </> "Main.runerror.check"+ runShouldSucceed = not $ Set.member mainRunErrorCheck allFiles++ mainStdoutCheck = sourceDir </> "Main.stdout.check"+ mainStdoutDiff = buildDir </> "Main.run.stdout.diff"+ shouldDiffStdout = Set.member mainStdoutCheck allFiles++ mainStderrCheck = sourceDir </> "Main.stderr.check"+ mainStderrDiff = buildDir </> "Main.run.stderr.diff"+ shouldDiffStderr = Set.member mainStderrCheck allFiles++ fragment+ | takeExtension filePath == "dcs" = CompileDC.FragmentSalt+ | takeExtension filePath == "dcl" = CompileDC.FragmentLite+ | otherwise = error "ddc-war.create: bad fragment"++ -- compile the .ds into a .bin+ compile = jobOfSpec (JobId testName (wayName way))+ $ CompileDC.Spec+ filePath (wayOptsComp way) fragment + buildDir mainCompStdout mainCompStderr+ (Just mainBin) compShouldSucceed++ -- run the binary+ run = jobOfSpec (JobId testName (wayName way))+ $ RunExe.Spec+ filePath + mainBin []+ mainRunStdout mainRunStderr+ runShouldSucceed++ -- diff errors produced by the compilation+ diffError = jobOfSpec (JobId testName (wayName way))+ $ Diff.Spec+ mainErrorCheck+ mainCompStderr mainCompDiff++ -- diff the stdout of the run+ diffStdout = jobOfSpec (JobId testName (wayName way))+ $ Diff.Spec+ mainStdoutCheck+ mainRunStdout mainStdoutDiff++ -- diff the stderr of the run+ diffStderr = jobOfSpec (JobId testName (wayName way))+ $ Diff.Spec+ mainStderrCheck+ mainRunStderr mainStderrDiff++ in if Set.member mainSH allFiles+ then Nothing+ else Just $ Chain + $ [compile]+ ++ (if compShouldSucceed then [run] else [diffError])+ ++ (if shouldDiffStdout then [diffStdout] else [])+ ++ (if shouldDiffStderr then [diffStderr] else [])++ | otherwise = Nothing+
− DDC/War/Create/CreateDCE.hs
@@ -1,87 +0,0 @@---module DDC.War.Create.CreateDCE- (create)-where-import DDC.War.Create.Way-import DDC.War.Driver-import System.FilePath-import DDC.War.Job ()-import Data.Set (Set)-import qualified DDC.War.Job.CompileDCE as CompileDCE-import qualified DDC.War.Job.RunExe as RunExe-import qualified DDC.War.Job.Diff as Diff-import qualified Data.Set as Set----- | Compile and run .dce files.-create :: Way -> Set FilePath -> FilePath -> Maybe Chain-create way allFiles filePath- | takeFileName filePath == "Main.dce"- = let - sourceDir = takeDirectory filePath- buildDir = sourceDir </> "war-" ++ wayName way- testName = filePath-- mainSH = sourceDir </> "Main.sh"- mainBin = buildDir </> "Main.bin"- mainCompStdout = buildDir </> "Main.compile.stdout"- mainCompStderr = buildDir </> "Main.compile.stderr"- mainCompDiff = buildDir </> "Main.compile.stderr.diff"- mainRunStdout = buildDir </> "Main.run.stdout"- mainRunStderr = buildDir </> "Main.run.stderr"-- mainErrorCheck = sourceDir </> "Main.error.check"- shouldSucceed = not $ Set.member mainErrorCheck allFiles-- mainStdoutCheck = sourceDir </> "Main.stdout.check"- mainStdoutDiff = buildDir </> "Main.run.stdout.diff"- shouldDiffStdout = Set.member mainStdoutCheck allFiles-- mainStderrCheck = sourceDir </> "Main.stderr.check"- mainStderrDiff = buildDir </> "Main.run.stderr.diff"- shouldDiffStderr = Set.member mainStderrCheck allFiles-- -- compile the .ds into a .bin- compile = jobOfSpec (JobId testName (wayName way))- $ CompileDCE.Spec- filePath- buildDir mainCompStdout mainCompStderr- (Just mainBin) shouldSucceed-- -- run the binary- run = jobOfSpec (JobId testName (wayName way))- $ RunExe.Spec- filePath - mainBin []- mainRunStdout mainRunStderr- True-- -- diff errors produced by the compilation- diffError = jobOfSpec (JobId testName (wayName way))- $ Diff.Spec- mainErrorCheck- mainCompStderr mainCompDiff-- -- diff the stdout of the run- diffStdout = jobOfSpec (JobId testName (wayName way))- $ Diff.Spec- mainStdoutCheck- mainRunStdout mainStdoutDiff-- -- diff the stderr of the run- diffStderr = jobOfSpec (JobId testName (wayName way))- $ Diff.Spec- mainStderrCheck- mainRunStderr mainStderrDiff-- in if Set.member mainSH allFiles- then Nothing- else Just $ Chain - $ [compile]- ++ (if shouldSucceed then [run] else [diffError])- ++ (if shouldDiffStdout then [diffStdout] else [])- ++ (if shouldDiffStderr then [diffStderr] else [])-- | otherwise = Nothing-
+ DDC/War/Create/CreateDSX.hs view
@@ -0,0 +1,46 @@++module DDC.War.Create.CreateDSX+ (create)+where+import DDC.War.Create.Way+import DDC.War.Driver+import System.FilePath+import DDC.War.Job ()+import Data.Set (Set)+import qualified DDC.War.Job.RunDSX as RunDSX+import qualified DDC.War.Job.Diff as Diff+import qualified Data.Set as Set+++-- | Run .dcx files with the interpreter.+create :: Way -> Set FilePath -> FilePath -> Maybe Chain+create way allFiles filePath+ | takeFileName filePath == "Test.dsx"+ = let + fileName = takeFileName filePath+ sourceDir = takeDirectory filePath+ buildDir = sourceDir </> "war-" ++ wayName way+ testName = filePath++ testDDCiStdout = buildDir </> replaceExtension fileName ".ddci-tetra.stdout"+ testDDCiStderr = buildDir </> replaceExtension fileName ".ddci-tetra.stderr"++ testStdoutCheck = sourceDir </> "Test.stdout.check"+ testStdoutDiff = buildDir </> "Test.stdout.check.diff"+ shouldDiffStdout = Set.member testStdoutCheck allFiles++ jobRun = jobOfSpec (JobId testName (wayName way))+ $ RunDSX.Spec+ filePath+ buildDir testDDCiStdout testDDCiStderr++ jobDiff = jobOfSpec (JobId testName (wayName way))+ $ Diff.Spec+ testStdoutCheck+ testDDCiStdout testStdoutDiff++ in Just $ Chain + $ [jobRun] + ++ (if shouldDiffStdout then [jobDiff] else [])++ | otherwise = Nothing
DDC/War/Driver/Gang.hs view
@@ -41,8 +41,7 @@ -> IO () runChainIO tmpDir mChanResult ixChain chain- = do uid <- getUniqueId -- TODO: buildbox should handle this- -- should not need process id.+ = do uid <- getUniqueId let state = buildStateDefault uid tmpDir runBuildWithState state
DDC/War/Interface/Controller.hs view
@@ -15,7 +15,7 @@ import Data.Maybe import Data.List import DDC.War.Interface.VT100 as VT100-import qualified System.Cmd+import qualified System.Process data Config@@ -167,7 +167,7 @@ -- Bogus pattern match to avoid warning. | otherwise- = error "DDC.War.Interface.Controller.handleResult: no match"+ = error "ddc-war.handleResult: no match" handleResult_askDiff :: FilePath -> FilePath -> FilePath -> IO Bool@@ -202,7 +202,7 @@ -- Update the expected output with the actual one | ('u': _) <- cmd- = do System.Cmd.system + = do System.Process.system $ "cp " ++ fileOut ++ " " ++ fileRef return True
DDC/War/Job.hs view
@@ -2,21 +2,22 @@ {-# OPTIONS -fno-warn-orphans #-} module DDC.War.Job where import DDC.War.Driver.Base-import qualified DDC.War.Job.CompileDCE as CompileDCE+import qualified DDC.War.Job.CompileDC as CompileDC import qualified DDC.War.Job.CompileDS as CompileDS import qualified DDC.War.Job.CompileHS as CompileHS import qualified DDC.War.Job.Diff as Diff import qualified DDC.War.Job.RunDCX as RunDCX+import qualified DDC.War.Job.RunDSX as RunDSX import qualified DDC.War.Job.RunExe as RunExe import qualified DDC.War.Job.Shell as Shell import BuildBox.Pretty -instance Spec CompileDCE.Spec CompileDCE.Result where+instance Spec CompileDC.Spec CompileDC.Result where specActionName _ = "compile"- buildFromSpec = CompileDCE.build+ buildFromSpec = CompileDC.build productOfResult _ result - = ProductStatus (ppr result) (CompileDCE.resultSuccess result)+ = ProductStatus (ppr result) (CompileDC.resultSuccess result) instance Spec CompileDS.Spec CompileDS.Result where@@ -50,6 +51,13 @@ buildFromSpec = RunDCX.build productOfResult _ result = ProductStatus (ppr result) (RunDCX.resultSuccess result)+++instance Spec RunDSX.Spec RunDSX.Result where+ specActionName _ = "run"+ buildFromSpec = RunDSX.build+ productOfResult _ result+ = ProductStatus (ppr result) (RunDSX.resultSuccess result) instance Spec RunExe.Spec RunExe.Result where
+ DDC/War/Job/CompileDC.hs view
@@ -0,0 +1,159 @@++module DDC.War.Job.CompileDC+ ( Spec (..)+ , Fragment (..)+ , Result (..)+ , resultSuccess+ , build)+where+import BuildBox.Command.File+import BuildBox.Command.System+import BuildBox.Build.Benchmark+import BuildBox.Data.Physical+import BuildBox.IO.Directory+import BuildBox.Pretty+import BuildBox+import System.FilePath+import qualified System.FilePath.Posix as P+import System.Directory+import Control.Monad+import Data.List+++-- | Use ddci-core to compile/make file a DCE file+data Spec+ = Spec+ { -- | Root source file of the program (the 'Main.ds')+ specFile :: FilePath + + -- | Extra DDC options for building in this way.+ , specOptionsDDC :: [String]++ -- | Language fragment.+ , specFragment :: Fragment++ -- | Scratch dir to do the build in.+ , specScratchDir :: String++ -- | Put what DDC says to stdout here.+ , specCompileStdout :: FilePath+ + -- | Put what DDC says to stderr here.+ , specCompileStderr :: FilePath ++ -- | If Just, then we're making an executable, and put the binary here.+ -- Otherwise simply compile it+ , specMaybeMainBin :: Maybe FilePath + + -- | True if the compile is expected to succeed, else not.+ , specShouldSucceed :: Bool }+ deriving Show+++-- | Language fragments that we can compile.+data Fragment+ = FragmentSalt -- File.dce+ | FragmentLite -- File.dcl+ deriving Show+++-- | Result of a compilation test.+data Result+ = ResultSuccess Seconds+ | ResultUnexpectedFailure+ | ResultUnexpectedSuccess+ deriving Show+++resultSuccess :: Result -> Bool+resultSuccess result+ = case result of+ ResultSuccess{} -> True+ _ -> False+++instance Pretty Result where+ ppr result+ = case result of + ResultSuccess seconds -> text "success" <+> parens (ppr seconds)+ ResultUnexpectedFailure -> text "failed"+ ResultUnexpectedSuccess -> text "unexpected"+++-- Build ----------------------------------------------------------------------+-- | Compile a Disciple Core Sea source file.+build :: Spec -> Build Result+build (Spec srcDC_ optionsDDC _fragment + buildDir mainCompOut mainCompErr+ mMainBin shouldSucceed)++ = do let ddcExe = "bin/ddc" <.> exe++ needs srcDC_+ needs ddcExe++ ddcBin <- io $ canonicalizePath ddcExe++ -- Normalise the file name relative to the current directory+ -- so that error messages don't change between hosts.+ srcDC' <- io $ makeRelativeToCurrentDirectory srcDC_++ -- Make the file path use consistent path separators across all hosts.+ let srcDC = flip map srcDC' $+ \c -> if isPathSeparator c+ then P.pathSeparator+ else c++ -- The directory holding the Main.dce file.+ let (srcDir, _srcFile) = splitFileName srcDC+ + -- Touch the .dce and .dcl files to the build directory to ensure they're built.+ sources <- io+ $ liftM (filter (\f -> isSuffixOf ".dcs" f || isSuffixOf ".dcl" f))+ $ lsFilesIn srcDir++ ssystemq $ "touch " ++ (intercalate " " sources)++ -- ensure the output directory exists+ ensureDir buildDir++ -- Do the compile.+ let compile+ | Just mainBin <- mMainBin+ = do -- If there is an existing binary then remove it.+ ssystemq $ "rm -f " ++ mainBin++ -- Build the program.+ timeBuild+ $ systemTee False + (ddcBin+ ++ " " ++ intercalate " " optionsDDC+ ++ " -output " ++ mainBin+ ++ " -output-dir " ++ buildDir+ ++ " -make " ++ srcDC)+ ""++ -- Compile the program.+ | otherwise+ = do timeBuild+ $ systemTee False+ (ddcBin+ ++ " " ++ intercalate " " optionsDDC+ ++ " -output-dir " ++ buildDir+ ++ " -compile " ++ srcDC)+ ""+ (time, (code, strOut, strErr))+ <- compile++ atomicWriteFile mainCompOut strOut+ atomicWriteFile mainCompErr strErr++ case code of+ ExitFailure _+ | shouldSucceed -> return ResultUnexpectedFailure+ + ExitSuccess+ | not shouldSucceed -> return ResultUnexpectedSuccess++ _ -> return $ ResultSuccess time+
− DDC/War/Job/CompileDCE.hs
@@ -1,125 +0,0 @@--module DDC.War.Job.CompileDCE- ( Spec (..)- , Result(..)- , resultSuccess- , build)-where-import BuildBox.Command.File-import BuildBox.Command.System-import BuildBox.Build.Benchmark-import BuildBox.Data.Physical-import BuildBox.IO.Directory-import BuildBox.Pretty-import BuildBox-import System.FilePath-import Control.Monad-import Data.List----- | Use ddci-core to compile/make file a DCE file-data Spec- = Spec- { -- | Root source file of the program (the 'Main.ds')- specFile :: FilePath - - -- | Scratch dir to do the build in.- , specScratchDir :: String-- -- | Put what DDC says to stdout here.- , specCompileStdout :: FilePath- - -- | Put what DDC says to stderr here.- , specCompileStderr :: FilePath -- -- | If Just, then we're making an executable, and put the binary here.- -- Otherwise simply compile it- , specMaybeMainBin :: Maybe FilePath - - -- | True if the compile is expected to succeed, else not.- , specShouldSucceed :: Bool }- deriving Show---data Result- = ResultSuccess Seconds- | ResultUnexpectedFailure- | ResultUnexpectedSuccess- deriving Show--resultSuccess :: Result -> Bool-resultSuccess result- = case result of- ResultSuccess{} -> True- _ -> False---instance Pretty Result where- ppr result- = case result of - ResultSuccess seconds -> text "success" <+> parens (ppr seconds)- ResultUnexpectedFailure -> text "failed"- ResultUnexpectedSuccess -> text "unexpected"----- Build ------------------------------------------------------------------------- | Compile a Disciple Core Sea source file.-build :: Spec -> Build Result-build (Spec srcDCE- buildDir mainCompOut mainCompErr- mMainBin shouldSucceed)-- = do needs srcDCE- needs "bin/ddci-core"-- -- The directory holding the Main.dce file.- let (srcDir, _srcFile) = splitFileName srcDCE- - -- Touch the .dce files to the build directory to ensure they're built.- sources <- io- $ liftM (filter (\f -> isSuffixOf ".dce" f))- $ lsFilesIn srcDir-- ssystemq $ "touch " ++ (intercalate " " sources)-- -- ensure the output directory exists- ensureDir buildDir-- -- Do the compile.- let compile- | Just mainBin <- mMainBin- = do -- If there is an existing binary then remove it.- ssystemq $ "rm -f " ++ mainBin-- -- Build the program.- timeBuild- $ systemTee False - ("bin/ddci-core"- ++ " -set output " ++ mainBin- ++ " -set outputdir " ++ buildDir- ++ " -make " ++ srcDCE)- ""-- -- Compile the program.- | otherwise- = do timeBuild- $ systemTee False- ("bin/ddci-core"- ++ " -set outputdir " ++ buildDir- ++ " -compile " ++ srcDCE)- ""- (time, (code, strOut, strErr))- <- compile-- atomicWriteFile mainCompOut strOut- atomicWriteFile mainCompErr strErr-- case code of- ExitFailure _- | shouldSucceed -> return ResultUnexpectedFailure- - ExitSuccess- | not shouldSucceed -> return ResultUnexpectedSuccess-- _ -> return $ ResultSuccess time-
DDC/War/Job/CompileDS.hs view
@@ -74,8 +74,10 @@ buildDir mainCompOut mainCompErr mMainBin shouldSucceed) - = do needs srcDS- needs "bin/ddc"+ = do let ddcaExe = "bin/ddc-alpha" <.> exe++ needs srcDS+ needs ddcaExe -- The directory holding the Main.ds file. let (srcDir, _srcFile) = splitFileName srcDS@@ -100,7 +102,7 @@ -- Build the program. timeBuild $ systemTee False - ("bin/ddc"+ (ddcaExe ++ " -v -make " ++ srcDS ++ " -o " ++ mainBin ++ " -outputdir " ++ buildDir@@ -113,7 +115,7 @@ | otherwise = do timeBuild $ systemTee False- ("bin/ddc"+ (ddcaExe ++ " -c " ++ srcDS ++ " -outputdir " ++ buildDir ++ " " ++ intercalate " " optionsDDC
DDC/War/Job/CompileHS.hs view
@@ -114,6 +114,7 @@ = do let str = "# Generated Makefile\n\n" ++ "include make/build.mk\n\n" ++ mainBin ++ " : " ++ mainHs ++ "\n"- ++ "\t$(GHC) $(GHC_LANGUAGE) $(DDC_PACKAGES) -ipackages/ddc-main --make $^ -o $@\n\n"+ ++ "\t$(GHC) $(GHC_LANGUAGE) $(DDC_PACKAGES)"+ ++ " -ipackages/ddc-alpha/src -ipackages/ddc-core-llvm --make $^ -o $@\n\n" io $ writeFile outfile str
DDC/War/Job/Diff.hs view
@@ -60,7 +60,7 @@ -- Run the binary. (_code, strOut, _strErr) <- systemTee False - (diffExe ++ " " ++ fileRef ++ " " ++ fileOut)+ (diffExe ++ " --ignore-space-change " ++ fileRef ++ " " ++ fileOut) "" -- Write its output to file.
DDC/War/Job/RunDCX.hs view
@@ -12,6 +12,7 @@ import BuildBox.Pretty import BuildBox import System.Directory+import System.FilePath -- | Feed a file into DDCi-core @@ -56,13 +57,15 @@ build (Spec srcDCX buildDir testRunStdout testRunStderr) - = do needs srcDCX- needs "bin/ddci-core"+ = do let ddciExe = "bin/ddci-core" <.> exe + needs srcDCX+ needs ddciExe+ -- ensure the output directory exists ensureDir buildDir - ddciBin' <- io $ canonicalizePath "bin/ddci-core"+ ddciBin' <- io $ canonicalizePath ddciExe (time, (code, strOut, strErr)) <- timeBuild
+ DDC/War/Job/RunDSX.hs view
@@ -0,0 +1,81 @@++module DDC.War.Job.RunDSX+ ( Spec (..)+ , Result (..)+ , resultSuccess+ , build)+where+import BuildBox.Command.File+import BuildBox.Command.System+import BuildBox.Build.Benchmark+import BuildBox.Data.Physical+import BuildBox.Pretty+import BuildBox+import System.Directory+import System.FilePath+++-- | Feed a file into DDCi-tetra+data Spec+ = Spec+ { -- | Root source file of the program (the 'Main.ds')+ specFile :: FilePath + + -- | Scratch dir to do the build in.+ , specScratchDir :: String++ -- | Put what DDC says to stdout here.+ , specCompileStdout :: FilePath+ + -- | Put what DDC says to stderr here.+ , specCompileStderr :: FilePath }+ deriving Show+++data Result+ = ResultSuccess Seconds+ | ResultFailure+ deriving Show+++resultSuccess :: Result -> Bool+resultSuccess result+ = case result of+ ResultSuccess{} -> True+ _ -> False+++instance Pretty Result where+ ppr result + = case result of+ ResultSuccess seconds -> text "success" <+> parens (ppr seconds)+ ResultFailure -> text "failed"+++-- | Compile a Haskell Source File+build :: Spec -> Build Result+build (Spec srcDSX+ buildDir testRunStdout testRunStderr)++ = do let ddciExe = "bin/ddci-tetra" <.> exe++ needs srcDSX+ needs ddciExe++ -- ensure the output directory exists+ ensureDir buildDir++ ddciBin' <- io $ canonicalizePath ddciExe++ (time, (code, strOut, strErr))+ <- timeBuild+ $ systemTee False+ (ddciBin' ++ " --batch " ++ srcDSX)+ ""+ atomicWriteFile testRunStdout strOut+ atomicWriteFile testRunStderr strErr++ case code of+ ExitSuccess -> return $ ResultSuccess time+ _ -> return $ ResultFailure+
DDC/War/Option.hs view
@@ -114,6 +114,9 @@ , t > 0 = eatn more $ spec { N.specBuildThreads = t} + | "-build-flavour" : flavour : more <- args+ = eatn more $ spec { N.specBuildFlavour = flavour }+ eatn (arg : _) _ = Left arg
DDC/War/Task/Nightly.hs view
@@ -33,9 +33,12 @@ -- | URL of DDC repository, used to update the snapshot. , specRemoteRepoURL :: String - -- | Number of threads to use when building.+ -- | Inject this number of threads into the config-override.mk file , specBuildThreads :: Int + -- | Inject this build flavour into the config-override.mk file+ , specBuildFlavour :: String+ -- | Cleanup after build , specCleanup :: Bool @@ -45,7 +48,6 @@ -- | If we're doing a continuous build, also build once on startup , specNow :: Bool - -- | Mailer to use to send build results, -- or Nothing if to not send mail. , specMailer :: Maybe Mailer@@ -56,7 +58,6 @@ -- | Send mail to this address. , specMailTo :: Maybe String - -- | User and host name to copy logs to eg 'overlord@deluge.ouroborus.net' , specLogUserHost :: Maybe String @@ -128,6 +129,7 @@ let urlSnapshot = specRemoteSnapshotURL spec let urlRepo = specRemoteRepoURL spec let buildThreads = specBuildThreads spec+ let buildFlavour = specBuildFlavour spec ensureDir buildDir inDir buildDir@@ -140,9 +142,9 @@ io $ writeFile "log/01-wget.stdout" getOut io $ writeFile "log/01-wget.stderr" getErr - needs (takeFileName urlSnapshot)+ needs (Remote.takeFileName urlSnapshot) outLn "* Unpacking snapshot"- ssystem $ "tar zxf " ++ takeFileName urlSnapshot+ ssystem $ "tar zxf " ++ Remote.takeFileName urlSnapshot inDir "ddc-head" $ do@@ -154,7 +156,9 @@ outLn "* Writing build config" needs "make" io $ writeFile "make/config-override.mk" - $ unlines ["THREADS = " ++ show buildThreads]+ $ unlines [ "THREADS = " ++ show buildThreads+ , "BUILDFLAVOUR = " ++ buildFlavour + , "" ] outLn "* Building project" needs "Makefile"
DDC/War/Task/Test.hs view
@@ -83,7 +83,7 @@ -- Canonicalize all the paths and put them in a set (which sorts them) testFilesSet <- io $ liftM (Set.fromList . Seq.toList)- $ Seq.mapM canonicalizePath+ $ Seq.mapM (canonicalizePath) $ testFilesRaw -- Skip over files with 'skip' in the path,@@ -168,10 +168,12 @@ -- on the console. (chanResult :: TChan Driver.Result) <- atomically $ newTChan++ tmp <- getTemporaryDirectory -- Fork a gang to run all the job chains. gang <- Driver.forkChainsIO - (specThreads spec) "/tmp"+ (specThreads spec) tmp (Just chanResult) chains -- Fork the controller to display results and manage user input.
LICENSE view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyrite (K) 2007-2012 The Disciplined Disciple Compiler Strike Force+Copyrite (K) 2007-2014 The Disciplined Disciple Compiler Strike Force All rights reversed. Permission is hereby granted, free of charge, to any person obtaining a copy@@ -13,18 +13,4 @@ The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.----------------------------------------------------------------------------------Under Australian law copyright is free and automatic.-By contributing to DDC authors grant all rights they have regarding their-contributions to the other members of the Disciplined Disciple Compiler Strike-Force, past, present and future, as well as placing their contributions under-the above license.--Use "darcs show authors" to get a list of Strike Force members.- ---------------------------------------------------------------------------------Redistributions of libraries in ./external are governed by their own licenses:-- - TinyPTC GNU Lesser General Public License-
Main.hs view
@@ -4,6 +4,7 @@ import BuildBox.Pretty import BuildBox import System.Environment+import System.Directory import qualified DDC.War.Task.Nightly as N import qualified DDC.War.Task.Test as T @@ -26,9 +27,8 @@ -- | Run tests from the provided directories mainTest :: T.Spec -> IO () mainTest spec- = let - in do- result <- runBuild "/tmp" $ T.build spec+ = do tmp <- getTemporaryDirectory+ result <- runBuild tmp $ T.build spec case result of Left err -> error $ render $ ppr err Right _ -> return ()@@ -37,7 +37,8 @@ -- | Run the nightly build. mainNightly :: N.Spec -> IO () mainNightly spec- = do result <- runBuild "/tmp" $ N.build spec+ = do tmp <- getTemporaryDirectory + result <- runBuild tmp $ N.build spec case result of Left err -> error $ render $ ppr err Right result' -> putStrLn $ render $ ppr result'
ddc-war.cabal view
@@ -1,5 +1,5 @@ Name: ddc-war-Version: 0.2.1.1+Version: 0.4.1.1 License: MIT License-file: LICENSE Author: The Disciplined Disciple Compiler Strike Force@@ -15,21 +15,22 @@ Executable ddc-war Build-depends:- base == 4.5.*,- containers == 0.4.*,- stm == 2.2.*,- directory == 1.1.*,- buildbox == 2.1.*,+ base >= 4.6 && < 4.8,+ containers == 0.5.*,+ directory == 1.2.*, random == 1.0.*,- process == 1.1.*,- filepath == 1.3.*-+ buildbox == 2.1.*,+ process == 1.2.*,+ filepath == 1.3.*,+ stm == 2.4.*+ Main-is: Main.hs Other-modules:- DDC.War.Create.CreateDCE+ DDC.War.Create.CreateDC DDC.War.Create.CreateDCX+ DDC.War.Create.CreateDSX DDC.War.Create.CreateMainDS DDC.War.Create.CreateMainHS DDC.War.Create.CreateMainSH@@ -40,11 +41,12 @@ DDC.War.Driver.Gang DDC.War.Interface.Controller DDC.War.Interface.VT100- DDC.War.Job.CompileDCE+ DDC.War.Job.CompileDC DDC.War.Job.CompileDS DDC.War.Job.CompileHS DDC.War.Job.Diff DDC.War.Job.RunDCX+ DDC.War.Job.RunDSX DDC.War.Job.RunExe DDC.War.Job.Shell DDC.War.Task.Nightly@@ -63,6 +65,7 @@ ScopedTypeVariables ghc-options:- -Wall -O2+ -Wall -fno-warn-unused-do-bind+ -fno-warn-missing-methods -threaded