From 55bde4022f4bdb274ff582350021ce4b305414c6 Mon Sep 17 00:00:00 2001
From: ijones <ijones@syntaxpolice.org>
Date: Thu, 10 Feb 2005 07:32:29 +0000
Subject: [PATCH] Added support for preprocessors in the UserHooks. Very
simple, backward-compatible change. Not sure how this never happened before,
it would be a shame to have worked on the preprocessor interface and not
exposed it to users at all.
Took this chance to move the test preprocessor out of the
PreProcessors module and into a test case.
---
Distribution/ModuleTest.hs | 14 +++++++-------
Distribution/PreProcess.hs | 12 ------------
Distribution/Simple.hs | 20 +++++++++++++-------
test/A/A.cabal | 2 +-
test/{A => withHooks}/C.testSuffix | 0
test/withHooks/Setup.description | 2 +-
test/withHooks/Setup.lhs | 12 ++++++++++++
7 files changed, 34 insertions(+), 28 deletions(-)
rename test/{A => withHooks}/C.testSuffix (100%)
diff --git a/Distribution/ModuleTest.hs b/Distribution/ModuleTest.hs
index e1dfca1ba3..8b589a9595 100644
--- a/Distribution/ModuleTest.hs
+++ b/Distribution/ModuleTest.hs
@@ -185,8 +185,6 @@ tests currDir
assertBool "build did not create the executable: testA"
doesFileExist "dist/build/testB" >>=
assertBool "build did not create the executable: testB"
- doesFileExist "dist/build/C.o" >>=
- assertBool "C.testSuffix did not get compiled to C.o."
assertCmd "./setup sdist"
"setup sdist returned error code"
doesFileExist "dist/test-1.0.tgz" >>=
@@ -215,10 +213,6 @@ tests currDir
doesFileExist (targetDir `joinFileName` "libHStest-1.0.a")
>>= assertBool "library doesn't exist"
assertEqual "install returned error code" ExitSuccess instRetCode,
- TestLabel "package A: GHC and clean" $ TestCase $
- do system "./setup clean"
- doesFileExist "C.hs" >>=
- assertEqual "C.hs (a generated file) not cleaned." False,
TestLabel "package withHooks: GHC building" $ TestCase $
do setCurrentDirectory $ (testdir `joinFileName` "withHooks")
system "make clean"
@@ -229,7 +223,9 @@ tests currDir
assertCmd "./setup build"
"build returned error code"
doesFileExist "dist/build/withHooks" >>=
- assertBool "build did not create the executable: withHooks",
+ assertBool "build did not create the executable: withHooks"
+ doesFileExist "dist/build/C.o" >>=
+ assertBool "C.testSuffix did not get compiled to C.o.",
TestLabel "package withHooks: GHC and copy" $ TestCase $
do let targetDir = ",tmp"
instRetCode <- system $ "./setup copy --copy-prefix=" ++ targetDir
@@ -238,6 +234,10 @@ tests currDir
doesFileExist ",tmp/bin/withHooks"
>>= assertBool "executable doesn't exist"
assertEqual "install returned error code" ExitSuccess instRetCode,
+ TestLabel "package withHooks: GHC and clean" $ TestCase $
+ do system "./setup clean"
+ doesFileExist "C.hs" >>=
+ assertEqual "C.hs (a generated file) not cleaned." False,
TestLabel "package twoMains: GHC building" $ TestCase $
do setCurrentDirectory $ (testdir `joinFileName` "twoMains")
system "make clean"
diff --git a/Distribution/PreProcess.hs b/Distribution/PreProcess.hs
index 7bc6d179e2..1d92f86d71 100644
--- a/Distribution/PreProcess.hs
+++ b/Distribution/PreProcess.hs
@@ -241,17 +241,6 @@ ppAlex _ lbi
hcFlags GHC = ["-g"]
hcFlags _ = []
-ppTestHandler :: FilePath -- ^InFile
- -> FilePath -- ^OutFile
- -> Int -- ^verbose
- -> IO ExitCode
-ppTestHandler inFile outFile verbose
- = do when (verbose > 0) $
- putStrLn (inFile++" has been preprocessed as a test to "++outFile)
- stuff <- readFile inFile
- writeFile outFile ("-- this file has been preprocessed as a test\n\n" ++ stuff)
- return ExitSuccess
-
standardPP :: String -> [String] -> PreProcessor
standardPP eName args inFile outFile verbose
= rawSystemVerbose verbose eName (args ++ ["-o" ++ outFile, inFile])
@@ -274,5 +263,4 @@ knownSuffixHandlers =
, ("y", ppHappy)
, ("ly", ppHappy)
, ("cpphs", ppCpp)
- , ("testSuffix", \ _ _ -> ppTestHandler)
]
diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs
index 71843608eb..eb13db7fac 100644
--- a/Distribution/Simple.hs
+++ b/Distribution/Simple.hs
@@ -64,7 +64,8 @@ module Distribution.Simple (
import Distribution.Package --must not specify imports, since we're exporting moule.
import Distribution.PackageDescription
import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes, ppCpp',
- ppUnlit, removePreprocessedPackage, preprocessSources)
+ ppUnlit, removePreprocessedPackage,
+ preprocessSources, PPSuffixHandler)
import Distribution.Setup
import Distribution.Simple.Build ( build )
@@ -110,6 +111,7 @@ data UserHooks = UserHooks
{
runTests :: Args -> Bool -> IO ExitCode, -- ^Used for @.\/setup test@
readDesc :: IO (Maybe PackageDescription), -- ^Read the description file
+ hookedPreProcessors :: [ PPSuffixHandler ], -- ^Add custom preprocessors
preConf :: Args -> ConfigFlags -> IO HookedBuildInfo,
postConf :: Args -> LocalBuildInfo -> IO ExitCode,
@@ -175,7 +177,10 @@ defaultMainWorker :: PackageDescription
-> Maybe UserHooks
-> IO ExitCode
defaultMainWorker pkg_descr_in action args hooks
- = do case action of
+ = do let pps = maybe knownSuffixHandlers
+ (\h -> knownSuffixHandlers ++ hookedPreProcessors h)
+ hooks
+ case action of
ConfigCmd flags -> do
(flags, optFns, args) <-
parseConfigureArgs flags args [buildDirOpt]
@@ -195,7 +200,7 @@ defaultMainWorker pkg_descr_in action args hooks
(flags, _, args) <- parseBuildArgs args []
pkg_descr <- hookOrInArgs preBuild args flags
localbuildinfo <- getPersistBuildConfig
- build pkg_descr localbuildinfo flags knownSuffixHandlers
+ build pkg_descr localbuildinfo flags pps
writeInstalledConfig pkg_descr localbuildinfo
postHook postBuild args localbuildinfo
HaddockCmd -> do
@@ -210,7 +215,7 @@ defaultMainWorker pkg_descr_in action args hooks
let tmpDir = joinPaths (buildDir lbi) "tmp"
createDirectoryIfMissing True tmpDir
createDirectoryIfMissing True targetDir
- preprocessSources pkg_descr lbi verbose knownSuffixHandlers
+ preprocessSources pkg_descr lbi verbose pps
inFiles <- sequence [moduleToFilePath [hsSourceDir bi] m ["hs", "lhs"]
| m <- exposedModules lib] >>= return . concat
mapM_ (mockPP ["-D__HADDOCK__"] pkg_descr bi lbi tmpDir verbose) inFiles
@@ -243,7 +248,7 @@ defaultMainWorker pkg_descr_in action args hooks
putStrLn $ "using : " ++ fromJust mPfe
let bi = libBuildInfo lib
let mods = exposedModules lib ++ hiddenModules (libBuildInfo lib)
- preprocessSources pkg_descr lbi verbose knownSuffixHandlers
+ preprocessSources pkg_descr lbi verbose pps
inFiles <- sequence [moduleToFilePath [hsSourceDir bi] m ["hs", "lhs"]
| m <- mods] >>= return . concat
let tmpDir = joinPaths (buildDir lbi) "tmp"
@@ -269,7 +274,7 @@ defaultMainWorker pkg_descr_in action args hooks
try $ removeDirectoryRecursive buildPref
try $ removeFile installedPkgConfigFile
try $ removeFile localBuildInfoFile
- removePreprocessedPackage pkg_descr currentDir (ppSuffixes knownSuffixHandlers)
+ removePreprocessedPackage pkg_descr currentDir (ppSuffixes pps)
postHook postClean args localbuildinfo
CopyCmd mprefix -> do
@@ -297,7 +302,7 @@ defaultMainWorker pkg_descr_in action args hooks
(verbose,_, args) <- parseSDistArgs args []
pkg_descr <- hookOrInArgs preSDist args verbose
localbuildinfo <- getPersistBuildConfig
- sdist srcPref distPref verbose knownSuffixHandlers pkg_descr
+ sdist srcPref distPref verbose pps pkg_descr
postHook postSDist args localbuildinfo
RegisterCmd uInst -> do
@@ -361,6 +366,7 @@ emptyUserHooks
{
runTests = res,
readDesc = return Nothing,
+ hookedPreProcessors = [],
preConf = rn,
postConf = res,
preBuild = rn,
diff --git a/test/A/A.cabal b/test/A/A.cabal
index e613294411..d768ed24c5 100644
--- a/test/A/A.cabal
+++ b/test/A/A.cabal
@@ -1,6 +1,6 @@
Name: test
Version: 1.0
-Hidden-Modules: B.A, C
+Hidden-Modules: B.A
Exposed-Modules: A
C-Sources: hello.c, c_src/hello.c
Extensions: ForeignFunctionInterface
diff --git a/test/A/C.testSuffix b/test/withHooks/C.testSuffix
similarity index 100%
rename from test/A/C.testSuffix
rename to test/withHooks/C.testSuffix
diff --git a/test/withHooks/Setup.description b/test/withHooks/Setup.description
index 7fcb15db67..7d4ecd5956 100644
--- a/test/withHooks/Setup.description
+++ b/test/withHooks/Setup.description
@@ -1,6 +1,6 @@
Name: withHooks
Version: 1.0
-exposed-modules: Main
+exposed-modules: Main, C
Executable: withHooks
Hidden-Modules: Main
diff --git a/test/withHooks/Setup.lhs b/test/withHooks/Setup.lhs
index fa7be32d4e..4ce34ccf1d 100644
--- a/test/withHooks/Setup.lhs
+++ b/test/withHooks/Setup.lhs
@@ -22,8 +22,20 @@
>
> myPreConf [] _ = error "--woohoo flag (for testing) not passed to ./setup configure."
+> ppTestHandler :: FilePath -- ^InFile
+> -> FilePath -- ^OutFile
+> -> Int -- ^verbose
+> -> IO ExitCode
+> ppTestHandler inFile outFile verbose
+> = do when (verbose > 0) $
+> putStrLn (inFile++" has been preprocessed as a test to "++outFile)
+> stuff <- readFile inFile
+> writeFile outFile ("-- this file has been preprocessed as a test\n\n" ++ stuff)
+> return ExitSuccess
+
> main :: IO ()
> main = defaultMainWithHooks defaultUserHooks
> {preConf=myPreConf,
+> hookedPreProcessors= [("testSuffix", \ _ _ -> ppTestHandler)],
> postClean=(\_ _ -> removeFile "Setup.buildinfo" >> return ExitSuccess)
> }
--
GitLab