Commit 444119fb authored by ian@well-typed.com's avatar ian@well-typed.com

Add a check that the Windows DLL split is OK; fixes #7780

parent 8c2f2803
......@@ -404,6 +404,7 @@ compiler_stage3_SplitObjs = NO
# There are too many symbols in the ghc package for a Windows DLL.
# We therefore need to split some of the modules off into a separate
# DLL. This clump are the modules reachable from DynFlags:
compiler_stage2_dll0_START_MODULE = DynFlags
compiler_stage2_dll0_MODULES = Annotations Avail Bag BasicTypes Binary Bitmap BlockId BreakArray BufWrite ByteCodeAsm ByteCodeInstr ByteCodeItbls ByteCodeLink CLabel Class CmdLineParser Cmm CmmCallConv CmmExpr CmmInfo CmmMachOp CmmNode CmmType CmmUtils CoAxiom CodeGen.Platform CodeGen.Platform.ARM CodeGen.Platform.NoRegs CodeGen.Platform.PPC CodeGen.Platform.PPC_Darwin CodeGen.Platform.SPARC CodeGen.Platform.X86 CodeGen.Platform.X86_64 Coercion Config Constants CoreArity CoreFVs CoreSubst CoreSyn CoreTidy CoreUnfold CoreUtils CostCentre DataCon Demand Digraph DriverPhases DynFlags Encoding ErrUtils Exception FamInstEnv FastBool FastFunctions FastMutInt FastString FastTypes Fingerprint FiniteMap ForeignCall Hoopl Hoopl.Dataflow HsBinds HsDecls HsDoc HsExpr HsImpExp HsLit HsPat HsSyn HsTypes HsUtils HscTypes Id IdInfo IfaceSyn IfaceType InstEnv InteractiveEvalTypes Kind ListSetOps Literal Maybes MkCore MkGraph MkId Module MonadUtils Name NameEnv NameSet ObjLink OccName OccurAnal OptCoercion OrdList Outputable PackageConfig Packages Pair Panic Platform PlatformConstants PprCmm PprCmmDecl PprCmmExpr PprCore PrelNames PrelRules Pretty PrimOp RdrName Reg RegClass Rules SMRep Serialized SrcLoc StaticFlags StgCmmArgRep StgCmmClosure StgCmmEnv StgCmmLayout StgCmmMonad StgCmmProf StgCmmTicky StgCmmUtils StgSyn Stream StringBuffer TcEvidence TcType TyCon Type TypeRep TysPrim TysWiredIn Unify UniqFM UniqSet UniqSupply Unique Util Var VarEnv VarSet
compiler_stage2_dll0_HS_OBJS = \
......
......@@ -485,6 +485,7 @@ utils/ghc-pwd/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/ghc-cabal/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/ghctags/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/dll-split/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/hpc/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/ghc-pkg/dist-install/package-data.mk: compiler/stage2/package-data.mk
utils/hsc2hs/dist-install/package-data.mk: compiler/stage2/package-data.mk
......@@ -654,6 +655,7 @@ BUILD_DIRS += utils/ghc-pkg
BUILD_DIRS += utils/deriveConstants
BUILD_DIRS += utils/testremove
BUILD_DIRS += $(MAYBE_GHCTAGS)
BUILD_DIRS += utils/dll-split
BUILD_DIRS += utils/ghc-pwd
BUILD_DIRS += utils/ghc-cabal
BUILD_DIRS += $(MAYBE_HPC)
......
......@@ -56,6 +56,17 @@ $1_$2_$3_ALL_OBJS = $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_NON_HS_OBJS)
ifeq "$3" "dyn"
ifneq "$$($1_$2_dll0_MODULES)" ""
$$($1_$2_$3_LIB) : $1/$2/dll-split.stamp
ifneq "$$($1_$2_$3_LIB0)" ""
$$($1_$2_$3_LIB0) : $1/$2/dll-split.stamp
endif
endif
$1/$2/dll-split.stamp: $$($1_$2_depfile_haskell) inplace/bin/dll-split$$(exeext)
inplace/bin/dll-split $$< "$$($1_$2_dll0_START_MODULE)" "$$($1_$2_dll0_MODULES)"
touch $$@
# Link a dynamic library
# On windows we have to supply the extra libs this one links to when building it.
ifeq "$$(HostOS_CPP)" "mingw32"
......
{-# LANGUAGE PatternGuards #-}
module Main (main) where
import Control.Monad
import Data.Function
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import System.Environment
import System.Exit
import System.FilePath
main :: IO ()
main = do args <- getArgs
case args of
[depfile, startModule, reachableModules] ->
doit depfile
(Module startModule)
(Set.fromList $ map Module $ words reachableModules)
_ -> error "dll-split: Bad args"
doit :: FilePath -> Module -> Set Module -> IO ()
doit depfile startModule expectedReachableMods
= do xs <- readFile depfile
let ys = catMaybes $ map mkEdge $ lines xs
mapping = mkMap ys
actualReachableMods = reachable mapping startModule
unless (actualReachableMods == expectedReachableMods) $ do
let extra = actualReachableMods Set.\\ expectedReachableMods
redundant = expectedReachableMods Set.\\ actualReachableMods
tellSet name set = unless (Set.null set) $
let ms = map moduleName (Set.toList set)
in putStrLn (name ++ ": " ++ unwords ms)
putStrLn ("Reachable modules from " ++ moduleName startModule
++ " out of date")
putStrLn "Please fix it, or building DLLs on Widnows may break (#7780)"
tellSet "Redundant modules" redundant
tellSet "Extra modules" extra
exitFailure
newtype Module = Module String
deriving (Eq, Ord)
moduleName :: Module -> String
moduleName (Module name) = name
-- Given:
-- compiler/stage2/build/X86/Regs.o : compiler/stage2/build/CodeGen/Platform.hi
-- Produce:
-- Just ("X86.Regs", "CodeGen.Platform")
mkEdge :: String -> Maybe (Module, Module)
mkEdge str = case words str of
[from, ":", to]
| Just from' <- getModule from
, Just to' <- getModule to ->
Just (from', to')
_ ->
Nothing
where getModule xs
= case stripPrefix "compiler/stage2/build/" xs of
Just xs' ->
let name = filePathToModuleName $ dropExtension xs'
in Just $ Module name
Nothing -> Nothing
filePathToModuleName = map filePathToModuleNameChar
filePathToModuleNameChar '/' = '.'
filePathToModuleNameChar c = c
mkMap :: [(Module, Module)] -> (Map Module (Set Module))
mkMap edges = let groupedEdges = groupBy ((==) `on` fst) $ sort edges
mkEdgeMap ys = (fst (head ys), Set.fromList (map snd ys))
in Map.fromList $ map mkEdgeMap groupedEdges
reachable :: Map Module (Set Module) -> Module -> Set Module
reachable mapping startModule = f Set.empty startModule
where f done m = if m `Set.member` done
then done
else foldl' f (m `Set.insert` done) (get m)
get m = Set.toList (Map.findWithDefault Set.empty m mapping)
Name: dll-split
Version: 0.1
Copyright: XXX
License: BSD3
-- XXX License-File: LICENSE
Author: XXX
Maintainer: XXX
Synopsis: XXX
Description:
XXX
Category: Development
build-type: Simple
cabal-version: >=1.2
Executable dll-split
Main-Is: Main.hs
Build-Depends: base >= 4 && < 5,
containers,
filepath
# -----------------------------------------------------------------------------
#
# (c) 2009 The University of Glasgow
#
# This file is part of the GHC build system.
#
# To understand how the build system works and how to modify it, see
# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture
# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying
#
# -----------------------------------------------------------------------------
utils/dll-split_USES_CABAL = YES
utils/dll-split_PACKAGE = dll-split
utils/dll-split_dist-install_PROGNAME = dll-split
utils/dll-split_dist-install_INSTALL = NO
utils/dll-split_dist-install_INSTALL_INPLACE = YES
$(eval $(call build-prog,utils/dll-split,dist-install,1))
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