f688990
diff -rN -u old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Configure.hs new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Configure.hs
f688990
--- old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Configure.hs	2011-01-22 14:49:22.000000000 +1000
f688990
+++ new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Configure.hs	2011-01-22 14:49:22.000000000 +1000
f688990
@@ -488,6 +488,7 @@
f688990
                     withVanillaLib      = fromFlag $ configVanillaLib cfg,
f688990
                     withProfLib         = fromFlag $ configProfLib cfg,
f688990
                     withSharedLib       = fromFlag $ configSharedLib cfg,
f688990
+                    withDynExe          = fromFlag $ configDynExe cfg,
f688990
                     withProfExe         = fromFlag $ configProfExe cfg,
f688990
                     withOptimization    = fromFlag $ configOptimization cfg,
f688990
                     withGHCiLib         = fromFlag $ configGHCiLib cfg,
f688990
diff -u ghc-7.0.1/libraries/Cabal/Distribution/Simple/GHC.hs.orig ghc-7.0.1/libraries/Cabal/Distribution/Simple/GHC.hs
f688990
--- ghc-7.0.1/libraries/Cabal/Distribution/Simple/GHC.hs.orig	2010-11-13 04:10:09.000000000 +1000
f688990
+++ ghc-7.0.1/libraries/Cabal/Distribution/Simple/GHC.hs	2011-01-22 14:52:52.000000000 +1000
f688990
@@ -537,6 +537,7 @@
f688990
      info verbosity "Building C Sources..."
f688990
      sequence_ [do let (odir,args) = constructCcCmdLine lbi libBi clbi pref
f688990
                                                         filename verbosity
f688990
+                                                        False
f688990
                                                         (withProfLib lbi)
f688990
                    createDirectoryIfMissingVerbose verbosity True odir
f688990
                    runGhcProg args
f688990
@@ -671,7 +672,7 @@
f688990
    info verbosity "Building C Sources."
f688990
    sequence_ [do let (odir,args) = constructCcCmdLine lbi exeBi clbi
f688990
                                           exeDir filename verbosity
f688990
-                                          (withProfExe lbi)
f688990
+                                          (withDynExe lbi) (withProfExe lbi)
f688990
                  createDirectoryIfMissingVerbose verbosity True odir
f688990
                  runGhcProg args
f688990
              | filename <- cSources exeBi]
f688990
@@ -679,7 +680,7 @@
f688990
   srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
f688990
 
f688990
   let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
f688990
-  let binArgs linkExe profExe =
f688990
+  let binArgs linkExe dynExe profExe =
f688990
              "--make"
f688990
           :  (if linkExe
f688990
                  then ["-o", targetDir  exeNameReal]
f688990
@@ -691,6 +692,9 @@
f688990
           ++ ["-l"++lib | lib <- extraLibs exeBi]
f688990
           ++ ["-L"++libDir | libDir <- extraLibDirs exeBi]
f688990
           ++ concat [["-framework", f] | f <- PD.frameworks exeBi]
f688990
+          ++ if dynExe
f688990
+                then ["-dynamic"]
f688990
+                else []
f688990
           ++ if profExe
f688990
                 then ["-prof",
f688990
                       "-hisuf", "p_hi",
f688990
@@ -704,9 +708,9 @@
f688990
   -- run at compile time needs to be the vanilla ABI so it can
f688990
   -- be loaded up and run by the compiler.
f688990
   when (withProfExe lbi && TemplateHaskell `elem` allExtensions exeBi)
f688990
-     (runGhcProg (binArgs False False))
f688990
+     (runGhcProg (binArgs (withDynExe lbi) False False))
f688990
 
f688990
-  runGhcProg (binArgs True (withProfExe lbi))
f688990
+  runGhcProg (binArgs True (withDynExe lbi) (withProfExe lbi))
f688990
 
f688990
 -- | Filter the "-threaded" flag when profiling as it does not
f688990
 --   work with ghc-6.8 and older.
f688990
@@ -836,9 +840,9 @@
f688990
     ierror     = error ("internal error: unexpected package db stack: " ++ show dbstack)
f688990
 
f688990
 constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
f688990
-                   -> FilePath -> FilePath -> Verbosity -> Bool
f688990
+                   -> FilePath -> FilePath -> Verbosity -> Bool -> Bool
f688990
                    ->(FilePath,[String])
f688990
-constructCcCmdLine lbi bi clbi pref filename verbosity profiling
f688990
+constructCcCmdLine lbi bi clbi pref filename verbosity dynamic profiling
f688990
   =  let odir | compilerVersion (compiler lbi) >= Version [6,4,1] []  = pref
f688990
               | otherwise = pref  takeDirectory filename
f688990
                         -- ghc 6.4.1 fixed a bug in -odir handling
f688990
@@ -852,6 +856,7 @@
f688990
          -- option to ghc here when compiling C code, so that the PROFILING
f688990
          -- macro gets defined. The macro is used in ghc's Rts.h in the
f688990
          -- definitions of closure layouts (Closures.h).
f688990
+         ++ ["-dynamic" | dynamic]
f688990
          ++ ["-prof" | profiling])
f688990
 
f688990
 ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
f688990
diff -rN -u old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/LocalBuildInfo.hs new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/LocalBuildInfo.hs
f688990
--- old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/LocalBuildInfo.hs	2011-01-22 14:49:22.000000000 +1000
f688990
+++ new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/LocalBuildInfo.hs	2011-01-22 14:49:22.000000000 +1000
f688990
@@ -118,6 +118,7 @@
f688990
         withVanillaLib:: Bool,  -- ^Whether to build normal libs.
f688990
         withProfLib   :: Bool,  -- ^Whether to build profiling versions of libs.
f688990
         withSharedLib :: Bool,  -- ^Whether to build shared versions of libs.
f688990
+        withDynExe    :: Bool,  -- ^Whether to link executables dynamically
f688990
         withProfExe   :: Bool,  -- ^Whether to build executables for profiling.
f688990
         withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
f688990
         withGHCiLib   :: Bool,  -- ^Whether to build libs suitable for use with GHCi.
f688990
diff -rN -u old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Setup.hs new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Setup.hs
f688990
--- old-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Setup.hs	2011-01-22 14:49:22.000000000 +1000
f688990
+++ new-ghc-7.0.1/libraries/Cabal/Distribution/Simple/Setup.hs	2011-01-22 14:49:22.000000000 +1000
f688990
@@ -270,6 +270,7 @@
f688990
     configVanillaLib    :: Flag Bool,     -- ^Enable vanilla library
f688990
     configProfLib       :: Flag Bool,     -- ^Enable profiling in the library
f688990
     configSharedLib     :: Flag Bool,     -- ^Build shared library
f688990
+    configDynExe        :: Flag Bool,     -- ^Enable dynamic linking of the executables.
f688990
     configProfExe       :: Flag Bool,     -- ^Enable profiling in the executables.
f688990
     configConfigureArgs :: [String],      -- ^Extra arguments to @configure@
f688990
     configOptimization  :: Flag OptimisationLevel,  -- ^Enable optimization.
f688990
@@ -301,6 +302,7 @@
f688990
     configVanillaLib   = Flag True,
f688990
     configProfLib      = Flag False,
f688990
     configSharedLib    = Flag False,
f688990
+    configDynExe       = Flag False,
f688990
     configProfExe      = Flag False,
f688990
     configOptimization = Flag NormalOptimisation,
f688990
     configProgPrefix   = Flag (toPathTemplate ""),
f688990
@@ -388,10 +390,16 @@
f688990
          configSharedLib (\v flags -> flags { configSharedLib = v })
f688990
          (boolOpt [] [])
f688990
 
f688990
+      ,option "" ["executable-dynamic"]
f688990
+         "Executable dynamic linking (fedora patch)"
f688990
+         configDynExe (\v flags -> flags { configDynExe = v })
f688990
+         (boolOpt [] [])
f688990
+
f688990
       ,option "" ["executable-profiling"]
f688990
          "Executable profiling"
f688990
          configProfExe (\v flags -> flags { configProfExe = v })
f688990
          (boolOpt [] [])
f688990
+
f688990
       ,multiOption "optimization"
f688990
          configOptimization (\v flags -> flags { configOptimization = v })
f688990
          [optArg' "n" (Flag . flagToOptimisationLevel)
f688990
@@ -553,6 +561,7 @@
f688990
     configVanillaLib    = mempty,
f688990
     configProfLib       = mempty,
f688990
     configSharedLib     = mempty,
f688990
+    configDynExe        = mempty,
f688990
     configProfExe       = mempty,
f688990
     configConfigureArgs = mempty,
f688990
     configOptimization  = mempty,
f688990
@@ -583,6 +592,7 @@
f688990
     configVanillaLib    = combine configVanillaLib,
f688990
     configProfLib       = combine configProfLib,
f688990
     configSharedLib     = combine configSharedLib,
f688990
+    configDynExe        = combine configDynExe,
f688990
     configProfExe       = combine configProfExe,
f688990
     configConfigureArgs = combine configConfigureArgs,
f688990
     configOptimization  = combine configOptimization,