Add support for symlink farming as a workaround for Stack

We want to be able to have the build tool use exactly the compiler and
related executables we choose. Stack doesn't really like that mode of
operation and insists on getting everything from PATH itself so this commit
adds support for creating a temporary symlink farm to convince Stack to use
the executables we want it to use.

1 files changed, 76 insertions, 0 deletions

diff --git a/tests/ProgramsTest.hs b/tests/ProgramsTest.hs
new file mode 100644
index 0000000..467c1cc
--- /dev/null
+++ b/tests/ProgramsTest.hs
@@ -0,0 +1,76 @@
+{-| 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 Text.Show.Pretty
+
+import CabalHelper.Compiletime.Types
+import CabalHelper.Compiletime.CompPrograms
+import Symlink (createSymbolicLink)
+
+main :: IO ()
+main = do
+  prog_name <- 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
+  let ghc_pkg = tmpdir </> "ghc-pkg-" ++ ver
+  let haddock = tmpdir </> "haddock-" ++ ver
+  let progs = defaultPrograms { ghcProgram = ghc }
+
+  createSymbolicLink prog ghc
+  createSymbolicLink prog ghc_pkg
+  createSymbolicLink 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"