125 lines
4.3 KiB
Haskell
125 lines
4.3 KiB
Haskell
module Grade where
|
|
|
|
import RunCommand
|
|
import KompTest
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import System.Directory
|
|
import System.Environment
|
|
import System.Exit
|
|
import System.IO
|
|
import System.Process
|
|
import System.FilePath
|
|
import System.Posix.Files
|
|
import Control.Exception
|
|
import Control.Monad
|
|
import System.Console.GetOpt
|
|
|
|
cmd c = do
|
|
putStrLn c
|
|
(out,err,code) <- runCommandStrWait c ""
|
|
putStrLn out
|
|
putStrLn err
|
|
|
|
|
|
makeAbsolute p = do
|
|
c <- getCurrentDirectory
|
|
return (c </> p)
|
|
|
|
maybeBuild _ [] = return ()
|
|
maybeBuild groupPath0 ((tarOpt,subm) : _) = do
|
|
cmd $ "tar -C "++groupPath0 ++" -"++ tarOpt++"xvf "++ show (groupPath0 </> subm)
|
|
cmd $ "make -C " ++ show (groupPath0 </> "src")
|
|
|
|
testAll compiler bs exts [testSuitePath00, groupPath0] = do
|
|
allFiles <- getDirectoryContents groupPath0
|
|
let submissions = [(opts, s) |
|
|
(opts, suff) <- [("z", ".tar.gz"), ("j", ".tar.bz2"), ("j", ".tar.bzip2"), ("", ".tar")],
|
|
s <- filter (suff `isSuffixOf`) allFiles]
|
|
maybeBuild groupPath0 submissions
|
|
let testSuitePath0 = groupPath0 </> "graderTestSuite"
|
|
cmd $ "rm -r " ++ testSuitePath0
|
|
cmd $ "cp -R " ++ testSuitePath00 </> "testsuite" ++ " " ++ testSuitePath0
|
|
let exePath0 = groupPath0 </> compiler
|
|
|
|
exePath <- makeAbsolute exePath0
|
|
groupPath <- makeAbsolute groupPath0
|
|
|
|
testSuitePath <- makeAbsolute testSuitePath0
|
|
curDir <- getCurrentDirectory
|
|
let exeDir = takeDirectory exePath
|
|
putStrLn $ "Running tests for " ++ exePath
|
|
|
|
let libpath = groupPath </> "lib"
|
|
let testProg = if null bs then Nothing
|
|
else case bs of
|
|
"JVM" : _ -> Just testJVM
|
|
"LLVM" : _ -> Just testLLVM
|
|
"x86" : _ -> Just testx86
|
|
b : _ -> error ("Unknown backend: " ++ b)
|
|
setCurrentDirectory exeDir
|
|
summary <- forM (testSpecs testProg exts libpath) $ \(points, name, tests) -> do
|
|
putStrLn $ name ++ "..."
|
|
results <- forM tests $ \(good, p, testFunction) -> do
|
|
testFiles <- getTestFilesForPath (testSuitePath </> p)
|
|
putStrLn $ p ++ "..."
|
|
rs <- testFunction exePath good testFiles
|
|
report p rs
|
|
return (p, rs)
|
|
putStrLn $ "Passed suites: " ++ (concat $ intersperse ", " $ [p | (p,rs) <- results, and rs])
|
|
let tally = concat (map snd results)
|
|
return (name, if and tally then points else (0 :: Int), tally)
|
|
|
|
setCurrentDirectory curDir
|
|
|
|
putStrLn $ "Summary:\n" ++ unlines (map summaryLine summary)
|
|
putStrLn $ "Credits total: " ++ show (sum [x | (_,x,_) <- summary])
|
|
|
|
padl n s = replicate (n - length s) ' ' ++ s
|
|
|
|
|
|
summaryLine (name, points, tests) =
|
|
padl 2 (show points) ++ " " ++ name ++ " " ++ "(" ++ show (length (filter id tests)) ++ "/" ++ show (length tests) ++ ")"
|
|
|
|
testSpecs testProg exts libpath =
|
|
(0, "Compiling core programs", [(True, "good",testCompilation), (False, "bad", testCompilation)]) :
|
|
map (\x -> (0,"Compiling extension " ++ x,[(True,"extensions/"++x,testCompilation)])) exts ++
|
|
case testProg of
|
|
Nothing -> []
|
|
Just backEnd ->
|
|
(0, "Running core programs", [(True, "good",backEnd libpath)]) :
|
|
map (\x -> (6,"Running extension " ++ x,[(True,"extensions/"++x,backEnd libpath)])) exts
|
|
|
|
|
|
|
|
testBack back cmd good fs = if good then test cmd fs back else return []
|
|
|
|
testJVM classpath = testBack (jvmBackend classpath)
|
|
testLLVM libpath = testBack (llvmBackend libpath)
|
|
testx86 libpath = testBack (x86Backend libpath)
|
|
|
|
data Flag = SearchScript String
|
|
| Extension String
|
|
| Back String
|
|
deriving (Eq,Ord)
|
|
|
|
flags =
|
|
[Option "s" ["search-compiler"] (ReqArg SearchScript "<compiler>") "search for the specified compiler",
|
|
Option "x" ["extension"] (ReqArg Extension "<extension>") "specify extensions to test",
|
|
Option "b" ["backend"] (ReqArg Back "<backend>") "specify backend"]
|
|
|
|
main = do
|
|
argv <- getArgs
|
|
case getOpt Permute flags argv of
|
|
(opts,args,[]) -> do
|
|
let searchList0 = [s | SearchScript s <- opts]
|
|
compiler = if null searchList0 then "jlc" else head searchList0
|
|
exts = [e | Extension e <- opts]
|
|
bs = [b | Back b <- opts]
|
|
testAll compiler bs exts args
|
|
(_,_,errs) -> do
|
|
hPutStrLn stderr (concat errs ++ usageInfo "" flags)
|
|
exitWith (ExitFailure 1)
|
|
|
|
where defaultSearchList = []
|