blob: 4e7c557347ffdfac447485111a4b1eeb86cc86a3 (
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
84
85
86
|
{-| This test checks if 'guessCompProgramPaths'\'s behaviour makes sense
-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
import Control.Monad
import Data.List
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 <- dropExtension <$> 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
let ext = case System.Info.os of
"mingw32" -> "exe"
_ -> ""
forM_ ["8.6.5", "8.4.4"] $ \ver -> do
let ghc = tmpdir </> "ghc-" ++ ver <.> ext
let ghc_pkg = tmpdir </> "ghc-pkg-" ++ ver <.> ext
let haddock = tmpdir </> "haddock-" ++ ver <.> ext
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"
|
