aboutsummaryrefslogblamecommitdiff
path: root/tests/golden-tests/runtests.hs
blob: 7d5ec86574887d6c5d896b7894b1f5d9bee74e93 (plain) (tree)
1
2
3
4
5
6
7
8
9
10



                         
                     


                    
                                
                                  
                             
                 
 
 
                                                                            
 
         
      

                              

                                                                       
 





                                                           
 



                                                    
                                                                                    


                                                        
                                                                                    

                   
                                                         
                                                                     




                                                                                  
                                         
                                          

                                  
                                                                            
                                                                                  
                                                                                



                                                                            
 
                         
                                                             
                                                              
                              
        
             
                                                            


                                  
                                                                                 




                                                                          
                                          
                                                                       
                                                     


                                                       
 
 
                                                            
 
 
                                                                                        
 
 

                                        
 
import System.Cmd
import System.Environment
import System.FilePath
import System.Exit
import System.Directory
import System.Process
import Data.List
import Control.Monad
import Text.Printf
import Text.Regex
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Verbosity
import Data.Maybe


haddockBase = ".." </> ".."
haddockPath = haddockBase </> "dist" </> "build" </> "haddock" </> "haddock"


main = do
  test
  putStrLn "All tests passed!"


test = do
  x <- doesFileExist haddockPath
  when (not x) $ die "you need to run 'cabal build' successfully first"

  contents <- getDirectoryContents "tests"
  args <- getArgs
  let (opts, spec) = span ("-" `isPrefixOf`) args
  let mods =
        case spec of
          x:_ | x /= "all" -> [x ++ ".hs"]
          _ -> filter ((==) ".hs" . takeExtension) contents

  let outdir = "output"
  let mods' = map ("tests" </>) mods
  putStrLn ""
  putStrLn "Haddock version: "
  h1 <- runProcess haddockPath ["--version"] Nothing
                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
  waitForProcess h1
  putStrLn ""
  putStrLn "GHC version: "
  h2 <- runProcess haddockPath ["--ghc-version"] Nothing
                   (Just [("haddock_datadir", haddockBase)]) Nothing Nothing Nothing
  waitForProcess h2
  putStrLn ""

  -- TODO: use Distribution.* to get the packages instead
  libdir <- rawSystemStdout normal haddockPath ["--print-ghc-libdir"]
  let librariesPath = ".."</>".."</>"share"</>"doc"</>"ghc"</>"html"</>"libraries"

  let mkDep name version =
        let path = init libdir </> librariesPath </> name ++ "-" ++ version
        in  "-i " ++ path ++ "," ++ path </> name ++ ".haddock"

  let base    = mkDep "base" "4.2.0.2"
      process = mkDep "process" "1.0.1.3"
      ghcprim = mkDep "ghc-prim" "0.2.0.0"

  putStrLn "Running tests..."
  handle <- runProcess haddockPath
                       (["-w", "-o", outdir, "-h", "--optghc=-fglasgow-exts"
                        , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods')
                       Nothing (Just [("haddock_datadir", haddockBase)]) Nothing
                       Nothing Nothing

  code <- waitForProcess handle
  when (code /= ExitSuccess) $ error "Haddock run failed! Exiting."
  check mods (if not (null args) && args !! 0 == "all" then False else True)


check modules strict = do
  forM_ modules $ \mod -> do
    let outfile = "output" </> (dropExtension mod ++ ".html")
    let reffile = "tests" </> dropExtension mod ++ ".html.ref"
    b <- doesFileExist reffile
    if b
      then do
        copyFile reffile ("output" </> takeFileName reffile)
        out <- readFile outfile
        ref <- readFile reffile
        if not $ haddockEq out ref
          then do
            putStrLn $ "Output for " ++ mod ++ " has changed! Exiting with diff:"
            let ref' = stripLinks ref
                out' = stripLinks out
            let reffile' = "output" </> takeFileName reffile ++ ".nolinks"
                outfile' = "output" </> takeFileName outfile ++ ".nolinks"
            writeFile reffile' ref'
            writeFile outfile' out'
            b <- programOnPath "colordiff"
            if b
              then system $ "colordiff " ++ reffile' ++ " " ++ outfile'
              else system $ "diff " ++ reffile' ++ " " ++ outfile'
            if strict then exitFailure else return ()
          else do
            putStrLn $ "Pass: " ++ mod
      else do
        putStrLn $ "Pass: " ++ mod ++ " (no .ref file)"


haddockEq file1 file2 = stripLinks file1 == stripLinks file2


stripLinks f = subRegex (mkRegexWithOpts "<A HREF=[^>]*>" False False) f "<A HREF=\"\">"


programOnPath p = do
  result <- findProgramLocation silent p
  return (isJust result)