[commit: ghc] master: Add framework flags when linking a dynamic library (dd7e188)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dd7e1880ae078a2d9f254dc5d8f330121e0ec291/ghc

>---------------------------------------------------------------

commit dd7e1880ae078a2d9f254dc5d8f330121e0ec291
Author: Christiaan Baaij <christiaan.baaij at gmail.com>
Date:   Wed Aug 5 14:20:56 2015 +0200

    Add framework flags when linking a dynamic library
    
    This fixes the GHC side of trac #10568. So `cabal install
    --ghc-options="-framework GLUT" GLUT` creates a correctly linked
    GLUT.dylib. We still need to explictly pass `--ghc-options="-framework
    GLUT"` because the Cabal side #10568 is not fixed.
    
    Update: the Cabal side of #10568 is fixed by
    [Cabal#2747](https://github.com/haskell/cabal/pull/2747)
    
    Test Plan: validate
    
    Reviewers: austin, rwbarton, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D1115
    
    GHC Trac Issues: #10568


>---------------------------------------------------------------

dd7e1880ae078a2d9f254dc5d8f330121e0ec291
 compiler/main/DriverPipeline.hs | 31 +++---------------------------
 compiler/main/SysTools.hs       | 42 ++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 29 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 97e64c4..f8b7c30 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1818,32 +1818,9 @@ linkBinary' staticLink dflags o_files dep_packages = do
                                                               -- This option must be placed before the library
                                                               -- that defines the symbol."
 
-    pkg_framework_path_opts <-
-        if platformUsesFrameworks platform
-        then do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
-                return $ map ("-F" ++) pkg_framework_paths
-        else return []
-
-    framework_path_opts <-
-        if platformUsesFrameworks platform
-        then do let framework_paths = frameworkPaths dflags
-                return $ map ("-F" ++) framework_paths
-        else return []
-
-    pkg_framework_opts <-
-        if platformUsesFrameworks platform
-        then do pkg_frameworks <- getPackageFrameworks dflags dep_packages
-                return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
-        else return []
-
-    framework_opts <-
-        if platformUsesFrameworks platform
-        then do let frameworks = cmdlineFrameworks dflags
-                -- reverse because they're added in reverse order from
-                -- the cmd line:
-                return $ concat [ ["-framework", fw]
-                                | fw <- reverse frameworks ]
-        else return []
+    -- frameworks
+    pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages
+    let framework_opts = getFrameworkOpts dflags platform
 
         -- probably _stub.o files
     let extra_ld_inputs = ldInputs dflags
@@ -1932,12 +1909,10 @@ linkBinary' staticLink dflags o_files dep_packages = do
                       ++ extra_ld_inputs
                       ++ map SysTools.Option (
                          rc_objs
-                      ++ framework_path_opts
                       ++ framework_opts
                       ++ pkg_lib_path_opts
                       ++ extraLinkObj:noteLinkObjs
                       ++ pkg_link_opts
-                      ++ pkg_framework_path_opts
                       ++ pkg_framework_opts
                       ++ debug_opts
                       ++ thread_opts
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 0b9537f..8ff0d9b 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -44,7 +44,12 @@ module SysTools (
         cleanTempDirs, cleanTempFiles, cleanTempFilesExcept,
         addFilesToClean,
 
-        Option(..)
+        Option(..),
+
+        -- frameworks
+        getPkgFrameworkOpts,
+        getFrameworkOpts
+
 
  ) where
 
@@ -1518,6 +1523,11 @@ linkDynLib dflags0 o_files dep_packages
         -- and last temporary shared object file
     let extra_ld_inputs = ldInputs dflags
 
+    -- frameworks
+    pkg_framework_opts <- getPkgFrameworkOpts dflags platform
+                                              (map packageKey pkgs)
+    let framework_opts = getFrameworkOpts dflags platform
+
     case os of
         OSMinGW32 -> do
             -------------------------------------------------------------
@@ -1603,8 +1613,10 @@ linkDynLib dflags0 o_files dep_packages
                  ++ [ Option "-install_name", Option instName ]
                  ++ map Option lib_path_opts
                  ++ extra_ld_inputs
+                 ++ map Option framework_opts
                  ++ map Option pkg_lib_path_opts
                  ++ map Option pkg_link_opts
+                 ++ map Option pkg_framework_opts
               )
         OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target")
         _ -> do
@@ -1633,3 +1645,31 @@ linkDynLib dflags0 o_files dep_packages
                  ++ map Option pkg_lib_path_opts
                  ++ map Option pkg_link_opts
               )
+
+getPkgFrameworkOpts :: DynFlags -> Platform -> [PackageKey] -> IO [String]
+getPkgFrameworkOpts dflags platform dep_packages
+  | platformUsesFrameworks platform = do
+    pkg_framework_path_opts <- do
+        pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
+        return $ map ("-F" ++) pkg_framework_paths
+
+    pkg_framework_opts <- do
+        pkg_frameworks <- getPackageFrameworks dflags dep_packages
+        return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
+
+    return (pkg_framework_path_opts ++ pkg_framework_opts)
+
+  | otherwise = return []
+
+getFrameworkOpts :: DynFlags -> Platform -> [String]
+getFrameworkOpts dflags platform
+  | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
+  | otherwise = []
+  where
+    framework_paths     = frameworkPaths dflags
+    framework_path_opts = map ("-F" ++) framework_paths
+
+    frameworks     = cmdlineFrameworks dflags
+    -- reverse because they're added in reverse order from the cmd line:
+    framework_opts = concat [ ["-framework", fw]
+                            | fw <- reverse frameworks ]