Commit a30b11fe authored by Ian Ross's avatar Ian Ross
Browse files

Allow preprocessors to specify extra C sources

Add functionality to allow preprocessors like hsc2hs and C2HS to inform
Cabal of extra C sources that they create that need to be compiled and
linked.  Includes hsc2hs-based test case.
parent fe880b9d
......@@ -300,6 +300,7 @@ test-suite package-tests
PackageTests.PathsModule.Executable.Check
PackageTests.PathsModule.Library.Check
PackageTests.PreProcess.Check
PackageTests.PreProcessExtraSources.Check
PackageTests.ReexportedModules.Check
PackageTests.TemplateHaskell.Check
PackageTests.TestOptions.Check
......
......@@ -52,7 +52,7 @@ import Distribution.Simple.Setup
import Distribution.Simple.BuildTarget
( BuildTarget(..), readBuildTargets )
import Distribution.Simple.PreProcess
( preprocessComponent, PPSuffixHandler )
( preprocessComponent, preprocessExtras, PPSuffixHandler )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms, pkgKey)
, Component(..), componentName, getComponent, componentBuildInfo
......@@ -79,6 +79,7 @@ import Distribution.Text
( display )
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe
( maybeToList )
import Data.Either
......@@ -197,8 +198,11 @@ buildComponent :: Verbosity
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity "Building library..."
buildLib verbosity numJobs pkg_descr lbi lib clbi
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = addExtraCSources libbi extras }
buildLib verbosity numJobs pkg_descr lbi lib' clbi
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
......@@ -206,18 +210,20 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
let -- The in place registration uses the "-inplace" suffix, not an ABI hash
ipkgid = inplacePackageId (packageId installedPkgInfo)
installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr
ipkgid lib lbi clbi
ipkgid lib' lbi clbi
registerPackage verbosity
installedPkgInfo pkg_descr lbi True -- True meaning in place
(withPackageDB lbi)
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building executable " ++ exeName exe ++ "..."
buildExe verbosity numJobs pkg_descr lbi exe clbi
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi
buildComponent verbosity numJobs pkg_descr lbi suffixes
......@@ -225,8 +231,11 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ testName test ++ "..."
buildExe verbosity numJobs pkg_descr lbi exe clbi
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi
buildComponent verbosity numJobs pkg_descr lbi0 suffixes
......@@ -242,10 +251,13 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
preprocessComponent pkg_descr comp lbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ testName test ++ "..."
buildLib verbosity numJobs pkg lbi lib libClbi
registerPackage verbosity ipi pkg lbi True $ withPackageDB lbi
buildExe verbosity numJobs pkg_descr lbi exe exeClbi
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
buildComponent _ _ _ _ _
......@@ -259,8 +271,11 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi False verbosity suffixes
extras <- preprocessExtras comp lbi
info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."
buildExe verbosity numJobs pkg_descr lbi exe exeClbi
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
buildComponent _ _ _ _ _
......@@ -269,6 +284,15 @@ buildComponent _ _ _ _ _
die $ "No support for building benchmark type " ++ display tt
-- | Add extra C sources generated by preprocessing to build
-- information.
addExtraCSources :: BuildInfo -> [FilePath] -> BuildInfo
addExtraCSources bi extras = bi { cSources = new }
where new = Set.toList $ old `Set.union` exs
old = Set.fromList $ cSources bi
exs = Set.fromList extras
replComponent :: Verbosity
-> PackageDescription
-> LocalBuildInfo
......@@ -280,12 +304,18 @@ replComponent :: Verbosity
replComponent verbosity pkg_descr lbi suffixes
comp@(CLib lib) clbi _ = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
replLib verbosity pkg_descr lbi lib clbi
extras <- preprocessExtras comp lbi
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
replLib verbosity pkg_descr lbi lib' clbi
replComponent verbosity pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
replExe verbosity pkg_descr lbi exe clbi
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
replExe verbosity pkg_descr lbi exe' clbi
replComponent verbosity pkg_descr lbi suffixes
......@@ -293,7 +323,10 @@ replComponent verbosity pkg_descr lbi suffixes
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi False verbosity suffixes
replExe verbosity pkg_descr lbi exe clbi
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
replExe verbosity pkg_descr lbi exe' clbi
replComponent verbosity pkg_descr lbi0 suffixes
......@@ -304,7 +337,10 @@ replComponent verbosity pkg_descr lbi0 suffixes
let (pkg, lib, libClbi, lbi, _, _, _) =
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
preprocessComponent pkg_descr comp lbi False verbosity suffixes
replLib verbosity pkg lbi lib libClbi
extras <- preprocessExtras comp lbi
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
replLib verbosity pkg lbi lib' libClbi
replComponent _ _ _ _
......@@ -318,7 +354,10 @@ replComponent verbosity pkg_descr lbi suffixes
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi False verbosity suffixes
replExe verbosity pkg_descr lbi exe exeClbi
extras <- preprocessExtras comp lbi
let ebi = buildInfo exe
exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
replExe verbosity pkg_descr lbi exe' exeClbi
replComponent _ _ _ _
......
......@@ -17,8 +17,9 @@
-- handlers. This module is not as good as it could be, it could really do with
-- a rewrite to address some of the problems we have with pre-processors.
module Distribution.Simple.PreProcess (preprocessComponent, knownSuffixHandlers,
ppSuffixes, PPSuffixHandler, PreProcessor(..),
module Distribution.Simple.PreProcess (preprocessComponent, preprocessExtras,
knownSuffixHandlers, ppSuffixes,
PPSuffixHandler, PreProcessor(..),
mkSimplePreProcessor, runSimplePreProcessor,
ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs,
ppHappy, ppAlex, ppUnlit, platformDefines
......@@ -52,7 +53,8 @@ import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, die, setupMessage, intercalate, copyFileVerbose, moreRecentFile
, findFileWithExtension, findFileWithExtension' )
, findFileWithExtension, findFileWithExtension'
, getDirectoryContentsRecursive )
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), programPath
, requireProgram, requireProgramVersion
......@@ -69,11 +71,12 @@ import Distribution.Version
import Distribution.Verbosity
import Data.Maybe (fromMaybe)
import Data.List (nub)
import Data.List (nub, isSuffixOf)
import System.Directory (doesFileExist)
import System.Info (os, arch)
import System.FilePath (splitExtension, dropExtensions, (</>), (<.>),
takeDirectory, normalise, replaceExtension)
takeDirectory, normalise, replaceExtension,
takeExtensions)
-- |The interface to a preprocessor, which may be implemented using an
-- external program, but need not be. The arguments are the name of
......@@ -129,6 +132,13 @@ data PreProcessor = PreProcessor {
-> IO () -- Should exit if the preprocessor fails
}
-- | Function to determine paths to possible extra C sources for a
-- preprocessor: just takes the path to the build directory and uses
-- this to search for C sources with names that match the
-- preprocessor's output name format.
type PreProcessorExtras = FilePath -> IO [FilePath]
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ())
-> (FilePath, FilePath)
-> (FilePath, FilePath) -> Verbosity -> IO ()
......@@ -251,7 +261,7 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha
Just (psrcLoc, psrcRelFile) -> do
let (srcStem, ext) = splitExtension psrcRelFile
psrcFile = psrcLoc </> psrcRelFile
pp = fromMaybe (error "Internal error in preProcess module: Just expected")
pp = fromMaybe (error "Distribution.Simple.PreProcess: Just expected")
(lookup (tailNotNull ext) handlers)
-- Preprocessing files for 'sdist' is different from preprocessing
-- for 'build'. When preprocessing for sdist we preprocess to
......@@ -455,6 +465,9 @@ ppHsc2hs bi lbi =
-> PackageIndex.insert rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
ppHsc2hsExtras :: PreProcessorExtras
ppHsc2hsExtras buildBaseDir = filter ("_hsc.c" `isSuffixOf`) `fmap`
getDirectoryContentsRecursive buildBaseDir
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppC2hs bi lbi =
......@@ -490,6 +503,10 @@ ppC2hs bi lbi =
where
pkgs = PackageIndex.topologicalOrder (installedPkgs lbi)
ppC2hsExtras :: PreProcessorExtras
ppC2hsExtras d = filter (\p -> takeExtensions p == ".chs.c") `fmap`
getDirectoryContentsRecursive d
--TODO: perhaps use this with hsc2hs too
--TODO: remove cc-options from cpphs for cabal-version: >= 1.10
getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
......@@ -620,3 +637,33 @@ knownSuffixHandlers =
, ("ly", ppHappy)
, ("cpphs", ppCpp)
]
-- |Standard preprocessors with possible extra C sources: c2hs, hsc2hs.
knownExtrasHandlers :: [ PreProcessorExtras ]
knownExtrasHandlers = [ ppC2hsExtras, ppHsc2hsExtras ]
-- | Find any extra C sources generated by preprocessing that need to
-- be added to the component (addresses issue #238).
preprocessExtras :: Component
-> LocalBuildInfo
-> IO [FilePath]
preprocessExtras comp lbi = case comp of
CLib _ -> pp $ buildDir lbi
(CExe Executable { exeName = nm }) ->
pp $ buildDir lbi </> nm </> nm ++ "-tmp"
CTest test -> do
case testInterface test of
TestSuiteExeV10 _ _ ->
pp $ buildDir lbi </> testName test </> testName test ++ "-tmp"
TestSuiteLibV09 _ _ ->
pp $ buildDir lbi </> stubName test </> stubName test ++ "-tmp"
TestSuiteUnsupported tt -> die $ "No support for preprocessing test "
++ "suite type " ++ display tt
CBench bm -> do
case benchmarkInterface bm of
BenchmarkExeV10 _ _ ->
pp $ buildDir lbi </> benchmarkName bm </> benchmarkName bm ++ "-tmp"
BenchmarkUnsupported tt -> die $ "No support for preprocessing benchmark "
++ "type " ++ display tt
where
pp dir = (map (dir </>) . concat) `fmap` forM knownExtrasHandlers ($ dir)
......@@ -32,6 +32,7 @@
running tests/benchmarks (#1821).
* Build shared libraries by default when linking executables dynamically.
* Build profiled libraries by default when profiling executables.
* Deal with extra C sources from preprocessors (#238).
1.20.0.1 Johan Tibell <johan.tibell@gmail.com> May 2014
* Fix streaming test output.
......
......@@ -705,8 +705,12 @@ simple build infrastructure understands the extensions:
* `.x` ([alex][])
* `.cpphs` ([cpphs][])
When building, Cabal will automatically run the appropriate preprocessor
and compile the Haskell module it produces.
When building, Cabal will automatically run the appropriate
preprocessor and compile the Haskell module it produces. For the
`c2hs` and `hsc2hs` preprocessors, Cabal will also automatically add,
compile and link any C sources generated by the preprocessor (produced
by `hsc2hs`'s `#def` feature or `c2hs`'s auto-generated wrapper
functions).
Some fields take lists of values, which are optionally separated by commas,
except for the `build-depends` field, where the commas are mandatory.
......
......@@ -25,6 +25,7 @@ import PackageTests.PackageTester (PackageSpec(..), compileSetup)
import PackageTests.PathsModule.Executable.Check
import PackageTests.PathsModule.Library.Check
import PackageTests.PreProcess.Check
import PackageTests.PreProcessExtraSources.Check
import PackageTests.TemplateHaskell.Check
import PackageTests.CMain.Check
import PackageTests.DeterministicAr.Check
......@@ -69,6 +70,8 @@ tests version inplaceSpec ghcPath ghcPkgPath =
, testCase "BuildDeps/InternalLibrary0"
(PackageTests.BuildDeps.InternalLibrary0.Check.suite version ghcPath)
, testCase "PreProcess" (PackageTests.PreProcess.Check.suite ghcPath)
, testCase "PreProcessExtraSources"
(PackageTests.PreProcessExtraSources.Check.suite ghcPath)
, testCase "TestStanza" (PackageTests.TestStanza.Check.suite ghcPath)
-- ^ The Test stanza test will eventually be required
-- only for higher versions.
......
module PackageTests.PreProcessExtraSources.Check (suite) where
import PackageTests.PackageTester
(PackageSpec(..), assertBuildSucceeded, cabal_build)
import System.FilePath
import Test.Tasty.HUnit
suite :: FilePath -> Assertion
suite ghcPath = do
let spec = PackageSpec
{ directory = "PackageTests" </> "PreProcessExtraSources"
, distPref = Nothing
, configOpts = ["--enable-tests", "--enable-benchmarks"]
}
result <- cabal_build spec ghcPath
assertBuildSucceeded result
{-# LANGUAGE ForeignFunctionInterface #-}
module Foo where
import Foreign.C.Types
#def int incr(int x) { return x + 1; }
foreign import ccall unsafe "Foo_hsc.h incr"
incr :: CInt -> CInt
module Main where
import Foo
main :: IO ()
main = do
let x = incr 4
return ()
name: PreProcessExtraSources
version: 0.1
license: BSD3
author: Ian Ross
stability: stable
category: PackageTests
build-type: Simple
Cabal-version: >= 1.2
description:
Check that preprocessors that generate extra C sources are handled.
Library
exposed-modules: Foo
build-depends: base
Executable my-executable
main-is: Main.hs
other-modules: Foo
build-depends: base
Test-Suite my-test-suite
main-is: Main.hs
type: exitcode-stdio-1.0
other-modules: Foo
build-depends: base
Benchmark my-benchmark
main-is: Main.hs
type: exitcode-stdio-1.0
other-modules: Foo
build-depends: base
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment