X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverPipeline.hs;h=0bac958418acfb09565ce21d3c285dc7fd6cd673;hb=0a5613f40b0e32cf59966e6b56b807cdbe80aa7b;hp=9ed55d71b03fe36289d51d6b58e4e6fd5d8632de;hpb=f205ce857a8d1cebeffe39233978b2bda9d33572;p=ghc-hetmet.git diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9ed55d7..0bac958 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -696,19 +696,30 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc = do let dflags0 = hsc_dflags hsc_env src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn - (dflags, unhandled_flags, warns) + (dflags1, unhandled_flags, warns) <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts - handleFlagWarnings dflags warns checkProcessArgsResult unhandled_flags - if not (dopt Opt_Cpp dflags) then + if not (dopt Opt_Cpp dflags1) then do + -- we have to be careful to emit warnings only once. + unless (dopt Opt_Pp dflags1) $ handleFlagWarnings dflags1 warns + -- no need to preprocess CPP, just pass input file along -- to the next phase of the pipeline. - return (HsPp sf, dflags, maybe_loc, input_fn) + return (HsPp sf, dflags1, maybe_loc, input_fn) else do - output_fn <- liftIO $ get_output_fn dflags (HsPp sf) maybe_loc - liftIO $ doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn - return (HsPp sf, dflags, maybe_loc, output_fn) + output_fn <- liftIO $ get_output_fn dflags1 (HsPp sf) maybe_loc + liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-} input_fn output_fn + -- re-read the pragmas now that we've preprocessed the file + -- See #2464,#3457 + src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn + (dflags2, unhandled_flags, warns) + <- liftIO $ parseDynamicNoPackageFlags dflags0 src_opts + unless (dopt Opt_Pp dflags2) $ handleFlagWarnings dflags2 warns + -- the HsPp pass below will emit warnings + checkProcessArgsResult unhandled_flags + + return (HsPp sf, dflags2, maybe_loc, output_fn) ------------------------------------------------------------------------------- -- HsPp phase @@ -730,7 +741,15 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc ] ++ map SysTools.Option hspp_opts ) - return (Hsc sf, dflags, maybe_loc, output_fn) + + -- re-read pragmas now that we've parsed the file (see #3674) + src_opts <- liftIO $ getOptionsFromFile dflags output_fn + (dflags1, unhandled_flags, warns) + <- liftIO $ parseDynamicNoPackageFlags dflags src_opts + handleFlagWarnings dflags1 warns + checkProcessArgsResult unhandled_flags + + return (Hsc sf, dflags1, maybe_loc, output_fn) ----------------------------------------------------------------------------- -- Hsc phase @@ -1374,7 +1393,7 @@ linkBinary dflags o_files dep_packages = do pkg_lib_paths <- getPackageLibraryPath dflags dep_packages let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths) -#ifdef linux_TARGET_OS +#ifdef elf_OBJ_FORMAT get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] | otherwise = ["-L" ++ l] #else @@ -1428,7 +1447,7 @@ linkBinary dflags o_files dep_packages = do let thread_opts | WayThreaded `elem` ways = [ -#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) +#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS) && !defined(haiku_TARGET_OS) "-lpthread" #endif #if defined(osf3_TARGET_OS) @@ -1573,7 +1592,7 @@ linkDynLib dflags o_files dep_packages = do #endif let pkg_lib_paths = collectLibraryPaths pkgs_no_rts let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths -#ifdef linux_TARGET_OS +#ifdef elf_OBJ_FORMAT get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] | otherwise = ["-L" ++ l] #else @@ -1643,16 +1662,22 @@ linkDynLib dflags o_files dep_packages = do -- later, so that it will not complain about the use of the option -- -undefined dynamic_lookup above. -- -install_name - -- Causes the dynamic linker to ignore the DYLD_LIBRARY_PATH when loading - -- this lib and instead look for it at its absolute path. - -- When installing the .dylibs (see target.mk), we'll change that path to - -- point to the place they are installed. Therefore, we won't have to set - -- up DYLD_LIBRARY_PATH specifically for ghc. + -- Mac OS/X stores the path where a dynamic library is (to be) installed + -- in the library itself. It's called the "install name" of the library. + -- Then any library or executable that links against it before it's + -- installed will search for it in its ultimate install location. By + -- default we set the install name to the absolute path at build time, but + -- it can be overridden by the -dylib-install-name option passed to ghc. + -- Cabal does this. ----------------------------------------------------------------------------- let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } - pwd <- getCurrentDirectory + instName <- case dylibInstallName dflags of + Just n -> return n + Nothing -> do + pwd <- getCurrentDirectory + return $ pwd `combine` output_fn SysTools.runLink dflags ([ SysTools.Option verb , SysTools.Option "-dynamiclib" @@ -1662,7 +1687,8 @@ linkDynLib dflags o_files dep_packages = do ++ map SysTools.Option ( md_c_flags ++ o_files - ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.5", "-install_name " ++ (pwd output_fn) ] + ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.5", + "-Wl,-read_only_relocs,suppress", "-install_name", instName ] ++ extra_ld_inputs ++ lib_path_opts ++ extra_ld_opts