diff options
Diffstat (limited to 'latex-test')
| -rwxr-xr-x | latex-test/accept.lhs | 46 | ||||
| -rwxr-xr-x | latex-test/run.lhs | 162 | 
2 files changed, 0 insertions, 208 deletions
| diff --git a/latex-test/accept.lhs b/latex-test/accept.lhs deleted file mode 100755 index 4d0b0127..00000000 --- a/latex-test/accept.lhs +++ /dev/null @@ -1,46 +0,0 @@ -#!/usr/bin/env runhaskell -\begin{code} -{-# LANGUAGE CPP #-} -import System.Environment -import System.FilePath -import System.Directory -import Data.List -import Control.Applicative -import Control.Monad - -baseDir :: FilePath -baseDir = takeDirectory __FILE__ - -main :: IO () -main = do -  contents <- filter (not . ignore) <$> getDirectoryContents (baseDir </> "out") -  args <- getArgs -  mapM_ copyDir $ if not (null args) -                  then filter ((`elem` args) . takeBaseName) contents -                  else contents -  where -    ignore = -      foldr (liftA2 (||)) (const False) [ -        (== ".") -      , (== "..") -      , isPrefixOf "index" -      , isPrefixOf "doc-index" -      ] - --- | Copy a directory to ref, one level deep. -copyDir :: FilePath -> IO () -copyDir dir = do -  let old = baseDir </> "out" </> dir -      new = baseDir </> "ref" </> dir -  alreadyExists <- doesDirectoryExist new -  unless alreadyExists $ do -    putStrLn (old ++ " -> " ++ new) -    createDirectoryIfMissing True new -    files <- getDirectoryContents old >>= filterM (liftM not . doesDirectoryExist) -    let files' = filter (\x -> x /= "." && x /= "..") files -    mapM_ (\f -> copyFile' (old </> f) (new </> f)) files' -      where -        copyFile' o n = do -          putStrLn $ o ++ " -> " ++ n -          copyFile o n -\end{code} diff --git a/latex-test/run.lhs b/latex-test/run.lhs deleted file mode 100755 index d3e39e90..00000000 --- a/latex-test/run.lhs +++ /dev/null @@ -1,162 +0,0 @@ -#!/usr/bin/env runhaskell -\begin{code} -{-# LANGUAGE CPP #-} -import Prelude hiding (mod) -import Control.Monad -import Control.Applicative -import Data.List -import Data.Maybe -import Distribution.InstalledPackageInfo hiding (dataDir) -import Distribution.Package (PackageName (..)) -import Distribution.Simple.Compiler -import Distribution.Simple.GHC -import Distribution.Simple.PackageIndex -import Distribution.Simple.Program -import Distribution.Simple.Utils -import Distribution.Verbosity -import System.IO -import System.Directory -import System.Environment -import System.Exit -import System.FilePath -import System.Process (ProcessHandle, runProcess, waitForProcess, system) - - -packageRoot, dataDir, haddockPath, baseDir, testDir, outDir, refDir :: FilePath -baseDir = takeDirectory __FILE__ -testDir       = baseDir </> "src" -refDir        = baseDir </> "ref" -outDir        = baseDir </> "out" -packageRoot   = baseDir </> ".." -dataDir       = packageRoot </> "resources" -haddockPath   = packageRoot </> "dist" </> "build" </> "haddock" </> "haddock" - - -main :: IO () -main = do -  test -  putStrLn "All tests passed!" - - -test :: IO () -test = do -  x <- doesFileExist haddockPath -  unless x $ System.Exit.die "you need to run 'cabal build' successfully first" - -  contents <- getDirectoryContents testDir - -  args <- getArgs -  let (opts, spec) = span ("-" `isPrefixOf`) args -      isDir x' = liftM2 (&&) (doesDirectoryExist $ testDir </> x') -                             (return $ x' /= "." && x' /= "..") -  modDirs <- case spec of -    y:_ | y /= "all" -> return [y] -    _ -> filterM isDir contents - -  let modDirs' = map (testDir </>) modDirs - -  -- add haddock_datadir to environment for subprocesses -  env <- Just . (:) ("haddock_datadir", dataDir) <$> getEnvironment - -  putStrLn "" -  putStrLn "Haddock version: " -  h1 <- runProcess haddockPath ["--version"] Nothing -                   env Nothing Nothing Nothing -  wait h1 "*** Running `haddock --version' failed!" -  putStrLn "" -  putStrLn "GHC version: " -  h2 <- runProcess haddockPath ["--ghc-version"] Nothing -                   env Nothing Nothing Nothing -  wait h2 "*** Running `haddock --ghc-version' failed!" -  putStrLn "" - -  -- TODO: maybe do something more clever here using haddock.cabal -  ghcPath <- fmap init $ rawSystemStdout normal haddockPath ["--print-ghc-path"] -  (_, _, conf) <- configure normal (Just ghcPath) Nothing defaultProgramConfiguration -  pkgIndex <- getInstalledPackages normal [GlobalPackageDB] conf -  let mkDep pkgName = -        fromMaybe (error "Couldn't find test dependencies") $ do -          let pkgs = lookupPackageName pkgIndex (PackageName pkgName) -          (_, pkgs') <- listToMaybe pkgs -          pkg <- listToMaybe pkgs' -          ifacePath <- listToMaybe (haddockInterfaces pkg) -          htmlPath <- listToMaybe (haddockHTMLs pkg) -          return ("-i " ++ htmlPath ++ "," ++ ifacePath) - -  let base    = mkDep "base" -      process = mkDep "process" -      ghcprim = mkDep "ghc-prim" - -  putStrLn "Running tests..." - -  forM_ modDirs' $ \modDir -> do -    testModules <- getDirectoryContents modDir - -    let mods = filter ((==) ".hs" . takeExtension) testModules -        mods' = map (modDir </>) mods - -    unless (null mods') $ do -      handle <- runProcess haddockPath -                (["-w", "-o", outDir </> last (splitPath modDir), "--latex" -                 , "--optghc=-fglasgow-exts" -                 , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods') -                Nothing env Nothing -                Nothing Nothing - -      wait handle "*** Haddock run failed! Exiting." - -  check modDirs (if not (null args) && args !! 0 == "all" then False else True) -  where -    wait :: ProcessHandle -> String -> IO () -    wait h msg = do -      r <- waitForProcess h -      unless (r == ExitSuccess) $ do -        hPutStrLn stderr msg -        exitFailure - -check :: [FilePath] -> Bool -> IO () -check modDirs strict = do -  forM_ modDirs $ \modDir -> do -    let oDir = outDir </> modDir -        rDir = refDir </> modDir - -    refDirExists <- doesDirectoryExist rDir -    when refDirExists $ do -      -- we're not creating sub-directories, I think. -      refFiles <- getDirectoryContents rDir >>= filterM doesFileExist - -      forM_ refFiles $ \rFile -> do -        let refFile = rDir </> rFile -            outFile = oDir </> rFile -        oe <- doesFileExist outFile -        if oe -          then do -            out <- readFile outFile -            ref <- readFile refFile - -            if out /= ref -               then do -                 putStrLn $ "Output for " ++ modDir ++ " has changed! Exiting with diff:" - -                 let reffile' = outDir </> takeFileName refFile ++ ".nolinks" -                     outfile' = outDir </> takeFileName outFile ++ ".ref.nolinks" -                 writeFile reffile' ref -                 writeFile outfile' out -                 r <- programOnPath "colordiff" -                 code <- if r -                   then system $ "colordiff " ++ reffile' ++ " " ++ outfile' -                   else system $ "diff " ++ reffile' ++ " " ++ outfile' -                 if strict then exitFailure else return () -                 unless (code == ExitSuccess) $ do -                   hPutStrLn stderr "*** Running diff failed!" -                   exitFailure -               else do -                 putStrLn $ "Pass: " ++ modDir -           else do -             putStrLn $ "Pass: " ++ modDir ++ " (no .ref file)" - -programOnPath :: FilePath -> IO Bool -programOnPath p = do -  result <- findProgramLocation silent p -  return (isJust result) -\end{code} | 
