@@ -11,6 +11,7 @@ import Test.Cabal.TestCode
11
11
12
12
import Distribution.Verbosity (normal , verbose , Verbosity )
13
13
import Distribution.Simple.Utils (getDirectoryContentsRecursive )
14
+ import Distribution.Simple.Program
14
15
15
16
import Options.Applicative
16
17
import Control.Concurrent.MVar
@@ -26,6 +27,9 @@ import System.IO
26
27
import System.FilePath
27
28
import System.Exit
28
29
import System.Process (callProcess , showCommandForUser )
30
+ import System.Directory
31
+ import Distribution.Pretty
32
+ import Data.Maybe
29
33
30
34
#if !MIN_VERSION_base(4,12,0)
31
35
import Data.Monoid ((<>) )
@@ -71,9 +75,22 @@ data MainArgs = MainArgs {
71
75
mainArgVerbose :: Bool ,
72
76
mainArgQuiet :: Bool ,
73
77
mainArgDistDir :: Maybe FilePath ,
78
+ mainArgCabalSpec :: Maybe CabalLibSpec ,
74
79
mainCommonArgs :: CommonArgs
75
80
}
76
81
82
+ data CabalLibSpec = BootCabalLib | InTreeCabalLib FilePath FilePath | SpecificCabalLib String FilePath
83
+
84
+ cabalLibSpecParser :: Parser CabalLibSpec
85
+ cabalLibSpecParser = bootParser <|> intreeParser <|> specificParser
86
+ where
87
+ bootParser = flag' BootCabalLib (long " boot-cabal-lib" )
88
+ intreeParser = InTreeCabalLib <$> strOption (long " intree-cabal-lib" <> metavar " ROOT" )
89
+ <*> option str ( help " Test TMP" <> long " test-tmp" )
90
+ specificParser = SpecificCabalLib <$> strOption (long " specific-cabal-lib" <> metavar " VERSION" )
91
+ <*> option str ( help " Test TMP" <> long " test-tmp" )
92
+
93
+
77
94
-- | optparse-applicative parser for 'MainArgs'
78
95
mainArgParser :: Parser MainArgs
79
96
mainArgParser = MainArgs
@@ -102,8 +119,52 @@ mainArgParser = MainArgs
102
119
( help " Dist directory we were built with"
103
120
<> long " builddir"
104
121
<> metavar " DIR" ))
122
+ <*> optional cabalLibSpecParser
105
123
<*> commonArgParser
106
124
125
+ -- Unpack and build a specific released version of Cabal and Cabal-syntax libraries
126
+ buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
127
+ buildCabalLibsProject projString verb mbGhc dir = do
128
+ let prog_db = userSpecifyPaths [(" ghc" , path) | Just path <- [mbGhc] ] defaultProgramDb
129
+ (cabal, _) <- requireProgram verb (simpleProgram " cabal" ) prog_db
130
+ (ghc, _) <- requireProgram verb ghcProgram prog_db
131
+
132
+ let pv = fromMaybe (error " no ghc version" ) (programVersion ghc)
133
+ let final_package_db = dir </> " dist-newstyle" </> " packagedb" </> " ghc-" ++ prettyShow pv
134
+ createDirectoryIfMissing True dir
135
+ writeFile (dir </> " cabal.project-test" ) projString
136
+
137
+ runProgramInvocation verb
138
+ ((programInvocation cabal
139
+ [" --store-dir" , dir </> " store"
140
+ , " --project-file=" ++ dir </> " cabal.project-test"
141
+ , " build"
142
+ , " -w" , programPath ghc
143
+ , " Cabal" , " Cabal-syntax" ] ) { progInvokeCwd = Just dir })
144
+ return final_package_db
145
+
146
+
147
+ buildCabalLibsSpecific :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
148
+ buildCabalLibsSpecific ver verb mbGhc builddir_rel = do
149
+ let prog_db = userSpecifyPaths [(" ghc" , path) | Just path <- [mbGhc] ] defaultProgramDb
150
+ (cabal, _) <- requireProgram verb (simpleProgram " cabal" ) prog_db
151
+ dir <- canonicalizePath (builddir_rel </> " specific" </> ver)
152
+ cgot <- doesDirectoryExist (dir </> " Cabal-" ++ ver)
153
+ unless cgot $
154
+ runProgramInvocation verb ((programInvocation cabal [" get" , " Cabal-" ++ ver]) { progInvokeCwd = Just dir })
155
+ csgot <- doesDirectoryExist (dir </> " Cabal-syntax-" ++ ver)
156
+ unless csgot $
157
+ runProgramInvocation verb ((programInvocation cabal [" get" , " Cabal-syntax-" ++ ver]) { progInvokeCwd = Just dir })
158
+
159
+ buildCabalLibsProject (" packages: Cabal-" ++ ver ++ " Cabal-syntax-" ++ ver) verb mbGhc dir
160
+
161
+
162
+ buildCabalLibsIntree :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
163
+ buildCabalLibsIntree root verb mbGhc builddir_rel = do
164
+ dir <- canonicalizePath (builddir_rel </> " intree" )
165
+ buildCabalLibsProject (" packages: " ++ root </> " Cabal" ++ " " ++ root </> " Cabal-syntax" ) verb mbGhc dir
166
+
167
+
107
168
main :: IO ()
108
169
main = do
109
170
-- By default, stderr is not buffered. This isn't really necessary
@@ -115,6 +176,27 @@ main = do
115
176
args <- execParser $ info (mainArgParser <**> helper) mempty
116
177
let verbosity = if mainArgVerbose args then verbose else normal
117
178
179
+ mpkg_db <-
180
+ -- Not path to cabal-install so we're not going to run cabal-install tests so we
181
+ -- can skip setting up a Cabal library to use with cabal-install.
182
+ case argCabalInstallPath (mainCommonArgs args) of
183
+ Nothing -> do
184
+ when (isJust $ mainArgCabalSpec args)
185
+ (putStrLn " Ignoring Cabal library specification as cabal-install tests are not running" )
186
+ return Nothing
187
+ -- Path to cabal-install is passed, so need to install the requested relevant version of Cabal
188
+ -- library.
189
+ Just {} ->
190
+ case mainArgCabalSpec args of
191
+ Nothing -> do
192
+ putStrLn " No Cabal library specified, using boot Cabal library with cabal-install tests"
193
+ return Nothing
194
+ Just BootCabalLib -> return Nothing
195
+ Just (InTreeCabalLib root build_dir) ->
196
+ Just <$> buildCabalLibsIntree root verbosity (argGhcPath (mainCommonArgs args)) build_dir
197
+ Just (SpecificCabalLib ver build_dir) ->
198
+ Just <$> buildCabalLibsSpecific ver verbosity (argGhcPath (mainCommonArgs args)) build_dir
199
+
118
200
-- To run our test scripts, we need to be able to run Haskell code
119
201
-- linked against the Cabal library under test. The most efficient
120
202
-- way to get this information is by querying the *host* build
@@ -140,7 +222,7 @@ main = do
140
222
-> IO result
141
223
runTest runner path
142
224
= runner Nothing [] path $
143
- [" --builddir" , dist_dir, path] ++ renderCommonArgs (mainCommonArgs args)
225
+ [" --builddir" , dist_dir, path] ++ [ " --extra-package-db= " ++ pkg_db | Just pkg_db <- [mpkg_db]] ++ renderCommonArgs (mainCommonArgs args)
144
226
145
227
case mainArgTestPaths args of
146
228
[path] -> do
0 commit comments