From 3b7d095a2fde8c031a987dd00aff4ad8e7421cf0 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Wed, 4 Oct 2017 16:57:44 +0200 Subject: Add a test which brings up a GHC session --- tests/CompileTest.hs | 2 +- tests/GhcSession.hs | 137 +++++++++++++++++++++++++++++++++++++++ tests/exeintlib/Exe.hs | 5 ++ tests/exeintlib/Setup.hs | 2 + tests/exeintlib/exelib.cabal | 21 ++++++ tests/exeintlib/intlib/IntLib.hs | 7 ++ tests/exeintlib/lib/Lib.hs | 8 +++ tests/exelib/Exe.hs | 5 ++ tests/exelib/Setup.hs | 2 + tests/exelib/exelib.cabal | 15 +++++ tests/exelib/lib/Lib.hs | 8 +++ 11 files changed, 211 insertions(+), 1 deletion(-) create mode 100644 tests/GhcSession.hs create mode 100644 tests/exeintlib/Exe.hs create mode 100644 tests/exeintlib/Setup.hs create mode 100644 tests/exeintlib/exelib.cabal create mode 100644 tests/exeintlib/intlib/IntLib.hs create mode 100644 tests/exeintlib/lib/Lib.hs create mode 100644 tests/exelib/Exe.hs create mode 100644 tests/exelib/Setup.hs create mode 100644 tests/exelib/exelib.cabal create mode 100644 tests/exelib/lib/Lib.hs (limited to 'tests') 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 -- cgit v1.2.3