aboutsummaryrefslogtreecommitdiff
path: root/tests/ProgramsTest.hs
blob: 1c28ced7f973057cc4b881656d6edcc2ab5d7b2d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
{-| This test checks if 'guessCompProgramPaths'\'s behaviour makes sense
-}

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

import Control.Monad
import Data.List
import Distribution.Simple.Utils (dropExeExtension)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO.Temp
import System.Info
import Text.Show.Pretty

import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.CompPrograms
import Symlink (createSymbolicLink)

main :: IO ()
main = do
  -- In windows, program name ends with .exe
  prog_name <- dropExeExtension <$> getProgName
  args <- getArgs
  case prog_name of
    "programs-test"
      | "ghc":ver:rest     <- args  -> ghc ver rest
      | "ghc-pkg":ver:rest <- args  -> ghc_pkg ver rest
      | "haddock":ver:rest <- args  -> haddock ver rest
      | otherwise -> do_test
    _
      | Just ver <- stripPrefix "ghc-pkg-" prog_name  -> ghc_pkg ver args
      | Just ver <- stripPrefix "ghc-" prog_name      -> ghc ver args
      | Just ver <- stripPrefix "haddock-" prog_name  -> haddock ver args
  where
    ghc _ver ["--info"] = putStrLn "[]" -- seems we can get away with that :)
    ghc  ver ["--numeric-version"] = putStrLn ver
    ghc _ver ["--supported-languages"] = return ()

    ghc_pkg ver ["--version"] =
      putStrLn $ "GHC package manager version " ++ ver

    haddock _ver ["--version"] =
      putStrLn $ -- cabal isn't very picky about haddock versions so we just
                 -- hardocde it here
        "Haddock version 2.20.0, (c) Simon Marlow 2006" ++
        "Ported to use the GHC API by David Waern 2006-2008"

do_test :: IO ()
do_test = do
  prog <- canonicalizePath =<< getExecutablePath

  withSystemTempDirectory "c-h-programs-test" $ \tmpdir -> do

  forM_ ["8.6.5", "8.4.4"] $ \ver -> do

  let ghc = tmpdir </> "ghc-" ++ ver <.> exeExtension
  let ghc_pkg = tmpdir </> "ghc-pkg-" ++ ver <.> exeExtension
  let haddock = tmpdir </> "haddock-" ++ ver <.> exeExtension
  let progs = defaultPrograms { ghcProgram = ghc }

  let link = case System.Info.os of
              "mingw32" -> copyFile
              _         -> createSymbolicLink

  link prog ghc
  link prog ghc_pkg
  link prog haddock

  let ?verbose = (==4)

  progs' <- guessCompProgramPaths progs

  pPrint (ghc, ghc_pkg, haddock) -- expected
  pPrint progs' -- actual

  when (not $ and [ ghcPkgProgram progs'  == ghc_pkg
                  , haddockProgram progs' == haddock
                  ])
    exitFailure

  putStr "\n\n"