Add a test which brings up a GHC session

12 files changed, 248 insertions, 1 deletions

diff --git a/cabal-helper.cabal b/cabal-helper.cabal
index 2062562..80002b3 100644
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -35,6 +35,15 @@ cabal-version:       >=1.14
 extra-source-files:  README.md
                      src/CabalHelper/Runtime/*.hs
 
+                     tests/*.hs
+
+                     tests/exelib/*.hs
+                     tests/exelib/lib/*.hs
+
+                     tests/exeintlib/*.hs
+                     tests/exeintlib/lib/*.hs
+                     tests/exeintlib/intlib/*.hs
+
 source-repository head
   type:     git
   location: https://github.com/DanielG/cabal-helper.git
@@ -155,6 +164,34 @@ test-suite compile-test
                      , utf8-string      < 1.1  && >= 1.0.1.1
                      , ghc-prim
 
+test-suite ghc-session
+  default-language:    Haskell2010
+  default-extensions:  NondecreasingIndentation
+  type:                exitcode-stdio-1.0
+  main-is:             GhcSession.hs
+  hs-source-dirs:      tests, src
+  ghc-options:         -Wall
+  build-depends:       base             < 5    && >= 4.5
+                     , ghc              < 8.3  && >= 7.4
+                     , ghc-paths        < 0.2  && >= 0.1.0.9
+                     , cabal-helper
+
+  -- Same as cabal-helper-wrapper
+  build-depends:       base             < 5    && >= 4.5
+                     , Cabal            < 2.1  && >= 2.0 || < 1.26 && >= 1.14
+                     , bytestring       < 0.11 && >= 0.9.2.1
+                     , directory        < 1.4  && >= 1.1.0.2
+                     , exceptions       < 0.9  && >= 0.8.3
+                     , filepath         < 1.5  && >= 1.3.0.0
+                     , mtl              < 2.3  && >= 2.0
+                     , process          < 1.7  && >= 1.1.0.1
+                     , template-haskell < 2.13 && >= 2.7.0.0
+                     , temporary        < 1.3  && >= 1.2.0.4
+                     , transformers     < 0.6  && >= 0.3.0.0
+                     , unix             < 2.8  && >= 2.5.1.1
+                     , utf8-string      < 1.1  && >= 1.0.1.1
+                     , ghc-prim
+
 executable cabal-helper-main
   default-language:    Haskell2010
   default-extensions:  NondecreasingIndentation
diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs
index 50cf555..de9b6ab 100644
--- a/tests/CompileTest.hs
+++ b/tests/CompileTest.hs
@@ -111,7 +111,7 @@ main = do
         where  ver = case cv of Left _ -> "HEAD"; Right v -> showVersion v
                status = case rv of
                          Right _ ->
-                             "suceeded"
+                             "succeeded"
                          Left rvc ->
                              "failed (exit code "++show rvc++")"
 
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
new file mode 100644
index 0000000..42193b9
--- /dev/null
+++ b/tests/GhcSession.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE TupleSections, ScopedTypeVariables #-}
+module Main where
+
+import GHC
+import GHC.Paths (libdir)
+import DynFlags
+
+import qualified Control.Exception as E
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.List
+import Data.Version
+import System.Environment (getArgs)
+import System.Exit
+import System.FilePath ((</>))
+import System.Directory
+import System.IO.Temp
+import System.Process (readProcess)
+
+import Distribution.Helper
+
+import CabalHelper.Shared.Common
+
+
+main :: IO ()
+main = do
+  args <- getArgs
+  topdir <- getCurrentDirectory
+  res <- mapM (setup topdir test) $ case args of
+    [] -> [ ("tests/exelib"   , parseVer "1.10")
+          , ("tests/exeintlib", parseVer "2.0")
+          ]
+    xs -> map (,parseVer "0") xs
+
+  if any (==False) $ concat res
+    then exitFailure
+    else exitSuccess
+
+cabalInstallVersion :: IO Version
+cabalInstallVersion =
+    parseVer . trim <$> readProcess "cabal" ["--numeric-version"] ""
+
+cabalInstallBuiltinCabalVersion :: IO Version
+cabalInstallBuiltinCabalVersion =
+    parseVer . trim <$> readProcess "cabal"
+        ["act-as-setup", "--", "--numeric-version"] ""
+
+setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version) -> IO [Bool]
+setup topdir act (srcdir, min_cabal_ver) = do
+    ci_ver <- cabalInstallVersion
+    c_ver <- cabalInstallBuiltinCabalVersion
+    let mreason
+          | (ci_ver < parseVer "1.24") =
+            Just $ "cabal-install-" ++ showVersion ci_ver ++ " is too old"
+          | c_ver < min_cabal_ver =
+            Just $ "Cabal-" ++ showVersion c_ver
+                   ++ " < " ++ showVersion min_cabal_ver
+          | otherwise =
+            Nothing
+
+    case mreason of
+      Just reason -> do
+        putStrLn $ "Skipping test '" ++ srcdir ++ "' because " ++ reason ++ "."
+        return []
+      Nothing -> do
+        withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do
+          setCurrentDirectory $ topdir </> srcdir
+          run "cabal" [ "sdist", "--output-dir", dir ]
+
+          setCurrentDirectory dir
+          run "cabal" [ "configure" ]
+--          run "cabal" [ "build" ]
+
+          act dir
+  where
+    run x xs = do
+      print $ x:xs
+      o <- readProcess x xs ""
+      putStrLn o
+      return ()
+
+test :: FilePath -> IO [Bool]
+test dir = do
+    let qe = mkQueryEnv dir (dir </> "dist")
+    cs <- runQuery qe $ components $ (,,) <$> entrypoints <.> ghcOptions
+    forM cs $ \(ep, opts, cn) -> do
+        let sopts = intercalate " " $ map formatArg $ "ghc" : opts
+        putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
+        compileModule ep opts
+  where
+    formatArg x
+        | "-" `isPrefixOf` x = "\n  "++x
+        | otherwise          = x
+
+compileModule :: ChEntrypoint -> [String] -> IO Bool
+compileModule ep opts = do
+
+    E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do
+
+    defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+
+    runGhc (Just libdir) $ do
+
+    dflags0 <- getSessionDynFlags
+    let dflags1 = dflags0 {
+        ghcMode   = CompManager
+      , ghcLink   = LinkInMemory
+      , hscTarget = HscInterpreted
+      , optLevel  = 0
+      }
+
+    (dflags2, _, _) <- parseDynamicFlags dflags1 (map noLoc opts)
+    _ <- setSessionDynFlags dflags2
+
+    ts <- mapM (\t -> guessTarget t Nothing) $
+         case ep of
+           ChLibEntrypoint ms ms' -> map unChModuleName $ ms ++ ms'
+           ChExeEntrypoint m  ms  -> [m] ++ map unChModuleName ms
+           ChSetupEntrypoint      -> ["Setup.hs"]
+    let ts' = map (\t -> t { targetAllowObjCode = False }) ts
+
+    setTargets ts'
+    _ <- load LoadAllTargets
+
+    setContext $ case ep of
+      ChLibEntrypoint ms ms' ->
+          map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms'
+      ChExeEntrypoint _  ms  ->
+          map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
+      ChSetupEntrypoint      ->
+          map (IIModule . mkModuleName) ["Main"]
+
+    liftIO $ print ExitSuccess
+    return True
+
+unChModuleName :: ChModuleName -> String
+unChModuleName (ChModuleName  mn) = mn
diff --git a/tests/exeintlib/Exe.hs b/tests/exeintlib/Exe.hs
new file mode 100644
index 0000000..200915f
--- /dev/null
+++ b/tests/exeintlib/Exe.hs
@@ -0,0 +1,5 @@
+module Main where
+
+import Lib
+
+main = print lib
diff --git a/tests/exeintlib/Setup.hs b/tests/exeintlib/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/tests/exeintlib/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/tests/exeintlib/exelib.cabal b/tests/exeintlib/exelib.cabal
new file mode 100644
index 0000000..807aac5
--- /dev/null
+++ b/tests/exeintlib/exelib.cabal
@@ -0,0 +1,21 @@
+name:                exeintlib
+version:             0
+build-type:          Simple
+cabal-version:       >=2.0
+
+library
+  exposed-modules:     Lib
+  hs-source-dirs:      lib
+  build-depends:       base, filepath, intlib
+  default-language:    Haskell2010
+
+library intlib
+  exposed-modules:     IntLib
+  hs-source-dirs:      intlib
+  build-depends:       base, directory
+  default-language:    Haskell2010
+
+executable exe
+  main-is:             Exe.hs
+  build-depends:       base, exeintlib
+  default-language:    Haskell2010
\ No newline at end of file
diff --git a/tests/exeintlib/intlib/IntLib.hs b/tests/exeintlib/intlib/IntLib.hs
new file mode 100644
index 0000000..6dde9d0
--- /dev/null
+++ b/tests/exeintlib/intlib/IntLib.hs
@@ -0,0 +1,7 @@
+module IntLib where
+
+import System.Directory
+
+directory = doesFileExist "Exe.hs"
+
+intlib = 1
diff --git a/tests/exeintlib/lib/Lib.hs b/tests/exeintlib/lib/Lib.hs
new file mode 100644
index 0000000..fe44c70
--- /dev/null
+++ b/tests/exeintlib/lib/Lib.hs
@@ -0,0 +1,8 @@
+module Lib where
+
+import System.FilePath
+import IntLib
+
+filepath  = "a" </> "b"
+
+lib = 1 + intlib
diff --git a/tests/exelib/Exe.hs b/tests/exelib/Exe.hs
new file mode 100644
index 0000000..7655927
--- /dev/null
+++ b/tests/exelib/Exe.hs
@@ -0,0 +1,5 @@
+module Main where
+
+import Lib
+
+main = print foo
diff --git a/tests/exelib/Setup.hs b/tests/exelib/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/tests/exelib/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/tests/exelib/exelib.cabal b/tests/exelib/exelib.cabal
new file mode 100644
index 0000000..0201b6f
--- /dev/null
+++ b/tests/exelib/exelib.cabal
@@ -0,0 +1,15 @@
+name:                exelib
+version:             0
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Lib
+  hs-source-dirs:      lib
+  build-depends:       base, filepath, directory
+  default-language:    Haskell2010
+
+executable exelib
+  main-is:             Exe.hs
+  build-depends:       base, exelib
+  default-language:    Haskell2010
\ No newline at end of file
diff --git a/tests/exelib/lib/Lib.hs b/tests/exelib/lib/Lib.hs
new file mode 100644
index 0000000..417a0ad
--- /dev/null
+++ b/tests/exelib/lib/Lib.hs
@@ -0,0 +1,8 @@
+module Lib where
+
+import System.Directory
+import System.FilePath
+
+filepath  = "a" </> "b"
+directory = doesFileExist "Exe.hs"
+foo = 1