diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | haddock.cabal | 10 | ||||
| -rwxr-xr-x | latex-test/accept.lhs | 46 | ||||
| -rw-r--r-- | latex-test/ref/Simple/Simple.tex | 17 | ||||
| -rw-r--r-- | latex-test/ref/Simple/haddock.sty | 57 | ||||
| -rw-r--r-- | latex-test/ref/Simple/main.tex | 11 | ||||
| -rwxr-xr-x | latex-test/run.lhs | 162 | ||||
| -rw-r--r-- | latex-test/src/Simple/Simple.hs | 5 |
8 files changed, 309 insertions, 0 deletions
@@ -1,5 +1,6 @@ /dist/ /html-test/out/ +/latex-test/out/ /doc/haddock /doc/autom4te.cache/ diff --git a/haddock.cabal b/haddock.cabal index ac13ae88..054a50f9 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -31,6 +31,9 @@ extra-source-files: src/haddock.sh html-test/src/*.hs html-test/ref/*.html + latex-test/src/*.hs + latex-test/ref/*/*.tex + latex-test/ref/*/*.sty data-dir: resources data-files: html/frames.html @@ -189,6 +192,13 @@ test-suite html-test hs-source-dirs: html-test build-depends: base, directory, process, filepath, Cabal +test-suite latex-test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: run.lhs + hs-source-dirs: latex-test + build-depends: base, directory, process, filepath, Cabal + test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 diff --git a/latex-test/accept.lhs b/latex-test/accept.lhs new file mode 100755 index 00000000..4d0b0127 --- /dev/null +++ b/latex-test/accept.lhs @@ -0,0 +1,46 @@ +#!/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/ref/Simple/Simple.tex b/latex-test/ref/Simple/Simple.tex new file mode 100644 index 00000000..89e849f8 --- /dev/null +++ b/latex-test/ref/Simple/Simple.tex @@ -0,0 +1,17 @@ +\haddockmoduleheading{Simple} +\label{module:Simple} +\haddockbeginheader +{\haddockverb\begin{verbatim} +module Simple ( + foo + ) where\end{verbatim}} +\haddockendheader + +\begin{haddockdesc} +\item[\begin{tabular}{@{}l} +foo\ ::\ t +\end{tabular}]\haddockbegindoc +This is foo. +\par + +\end{haddockdesc}
\ No newline at end of file diff --git a/latex-test/ref/Simple/haddock.sty b/latex-test/ref/Simple/haddock.sty new file mode 100644 index 00000000..6e031a98 --- /dev/null +++ b/latex-test/ref/Simple/haddock.sty @@ -0,0 +1,57 @@ +% Default Haddock style definitions. To use your own style, invoke +% Haddock with the option --latex-style=mystyle. + +\usepackage{tabulary} % see below + +% make hyperlinks in the PDF, and add an expandabale index +\usepackage[pdftex,bookmarks=true]{hyperref} + +\newenvironment{haddocktitle} + {\begin{center}\bgroup\large\bfseries} + {\egroup\end{center}} +\newenvironment{haddockprologue}{\vspace{1in}}{} + +\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}} + +\newcommand{\haddockbeginheader}{\hrulefill} +\newcommand{\haddockendheader}{\noindent\hrulefill} + +% a little gap before the ``Methods'' header +\newcommand{\haddockpremethods}{\vspace{2ex}} + +% inserted before \\begin{verbatim} +\newcommand{\haddockverb}{\small} + +% an identifier: add an index entry +\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}} + +% The tabulary environment lets us have a column that takes up ``the +% rest of the space''. Unfortunately it doesn't allow +% the \end{tabulary} to be in the expansion of a macro, it must appear +% literally in the document text, so Haddock inserts +% the \end{tabulary} itself. +\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} +\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}} + +\newcommand{\haddocktt}[1]{{\small \texttt{#1}}} +\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}} + +\makeatletter +\newenvironment{haddockdesc} + {\list{}{\labelwidth\z@ \itemindent-\leftmargin + \let\makelabel\haddocklabel}} + {\endlist} +\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}} +\makeatother + +% after a declaration, start a new line for the documentation. +% Otherwise, the documentation starts right after the declaration, +% because we're using the list environment and the declaration is the +% ``label''. I tried making this newline part of the label, but +% couldn't get that to work reliably (the space seemed to stretch +% sometimes). +\newcommand{\haddockbegindoc}{\hfill\\[1ex]} + +% spacing between paragraphs and no \parindent looks better +\parskip=10pt plus2pt minus2pt +\setlength{\parindent}{0cm} diff --git a/latex-test/ref/Simple/main.tex b/latex-test/ref/Simple/main.tex new file mode 100644 index 00000000..36536981 --- /dev/null +++ b/latex-test/ref/Simple/main.tex @@ -0,0 +1,11 @@ +\documentclass{book} +\usepackage{haddock} +\begin{document} +\begin{titlepage} +\begin{haddocktitle} + +\end{haddocktitle} +\end{titlepage} +\tableofcontents +\input{Simple} +\end{document}
\ No newline at end of file diff --git a/latex-test/run.lhs b/latex-test/run.lhs new file mode 100755 index 00000000..423dc6fd --- /dev/null +++ b/latex-test/run.lhs @@ -0,0 +1,162 @@ +#!/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 +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 $ 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} diff --git a/latex-test/src/Simple/Simple.hs b/latex-test/src/Simple/Simple.hs new file mode 100644 index 00000000..7c6b9744 --- /dev/null +++ b/latex-test/src/Simple/Simple.hs @@ -0,0 +1,5 @@ +module Simple (foo) where + +-- | This is foo. +foo :: t +foo = undefined |