summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/cmm/CmmPipeline.hs2
-rw-r--r--compiler/codeGen/StgCmmCon.hs4
-rw-r--r--compiler/main/DriverPipeline.hs10
-rw-r--r--compiler/main/DynFlags.hs39
-rw-r--r--compiler/main/SysTools.hs15
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs6
-rw-r--r--compiler/nativeGen/PIC.hs33
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs6
-rw-r--r--compiler/nativeGen/SPARC/CodeGen.hs2
-rw-r--r--compiler/nativeGen/X86/CodeGen.hs4
-rw-r--r--docs/users_guide/phases.rst24
-rw-r--r--docs/users_guide/shared_libs.rst4
-rw-r--r--testsuite/tests/dynlibs/Makefile6
-rw-r--r--testsuite/tests/dynlibs/T13702.hs9
-rw-r--r--testsuite/tests/dynlibs/T13702.stdout2
-rw-r--r--testsuite/tests/dynlibs/T13702a.hs12
-rw-r--r--testsuite/tests/dynlibs/all.T4
17 files changed, 131 insertions, 51 deletions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index bc827dfe87..edcaf7b789 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -163,7 +163,7 @@ cpsTop hsc_env proc =
|| -- Note [inconsistent-pic-reg]
usingInconsistentPicReg
usingInconsistentPicReg
- = case (platformArch platform, platformOS platform, gopt Opt_PIC dflags)
+ = case (platformArch platform, platformOS platform, positionIndependent dflags)
of (ArchX86, OSDarwin, pic) -> pic
(ArchPPC, OSDarwin, pic) -> pic
_ -> False
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index a76b8cc0a0..6438b8cd3c 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -191,7 +191,7 @@ because they don't support cross package data references well.
buildDynCon' dflags platform binder _ _cc con [arg]
| maybeIntLikeCon con
- , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags)
+ , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)
, NonVoid (StgLitArg (MachInt val)) <- arg
, val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer!
, val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...
@@ -205,7 +205,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
buildDynCon' dflags platform binder _ _cc con [arg]
| maybeCharLikeCon con
- , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags)
+ , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)
, NonVoid (StgLitArg (MachChar val)) <- arg
, let val_int = ord val :: Int
, val_int <= mAX_CHARLIKE dflags
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 7f70377c25..d94cbb4eb7 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1469,7 +1469,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
-- iOS requires external references to be loaded indirectly from the
-- DATA segment or dyld traps at runtime writing into TEXT: see #7722
rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic"
- | gopt Opt_PIC dflags = "pic"
+ | positionIndependent dflags = "pic"
| WayDyn `elem` ways dflags = "dynamic-no-pic"
| otherwise = "static"
tbaa | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
@@ -1936,10 +1936,8 @@ linkBinary' staticLink dflags o_files dep_packages = do
++ map SysTools.Option (
[]
- -- See Note [No PIE eating when linking]
- ++ (if sGccSupportsNoPie mySettings
- then ["-no-pie"]
- else [])
+ -- See Note [No PIE when linking]
+ ++ picCCOpts dflags
-- Permit the linker to auto link _symbol to _imp_symbol.
-- This lets us link against DLLs without needing an "import library".
@@ -2228,7 +2226,7 @@ joinObjectFiles dflags o_files output_fn = do
SysTools.Option "-nostdlib",
SysTools.Option "-Wl,-r"
]
- -- See Note [No PIE eating while linking] in SysTools
+ -- See Note [No PIE while linking] in SysTools
++ (if sGccSupportsNoPie mySettings
then [SysTools.Option "-no-pie"]
else [])
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 590d834008..d51f43478c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -59,6 +59,7 @@ module DynFlags (
tablesNextToCode, mkTablesNextToCode,
makeDynFlagsConsistent,
shouldUseColor,
+ positionIndependent,
Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,
wayGeneralFlags, wayUnsetGeneralFlags,
@@ -512,7 +513,9 @@ data GeneralFlag
| Opt_DeferTypeErrors
| Opt_DeferTypedHoles
| Opt_DeferOutOfScopeVariables
- | Opt_PIC
+ | Opt_PIC -- ^ @-fPIC@
+ | Opt_PIE -- ^ @-fPIE@
+ | Opt_PICExecutable -- ^ @-pie@
| Opt_SccProfilingOn
| Opt_Ticky
| Opt_Ticky_Allocd
@@ -1327,6 +1330,10 @@ data RtsOptsEnabled
shouldUseColor :: DynFlags -> Bool
shouldUseColor dflags = overrideWith (canUseColor dflags) (useColor dflags)
+-- | Are we building with @-fPIE@ or @-fPIC@ enabled?
+positionIndependent :: DynFlags -> Bool
+positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
+
-----------------------------------------------------------------------------
-- Ways
@@ -2665,6 +2672,8 @@ dynamic_flags_deps = [
#endif
, make_ord_flag defGhcFlag "relative-dynlib-paths"
(NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
+ , make_ord_flag defGhcFlag "pie" (NoArg (setGeneralFlag Opt_PICExecutable))
+ , make_ord_flag defGhcFlag "no-pie" (NoArg (unSetGeneralFlag Opt_PICExecutable))
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
@@ -3319,6 +3328,8 @@ dynamic_flags_deps = [
d { safeInfer = False }))
, make_ord_flag defGhcFlag "fPIC" (NoArg (setGeneralFlag Opt_PIC))
, make_ord_flag defGhcFlag "fno-PIC" (NoArg (unSetGeneralFlag Opt_PIC))
+ , make_ord_flag defGhcFlag "fPIE" (NoArg (setGeneralFlag Opt_PIC))
+ , make_ord_flag defGhcFlag "fno-PIE" (NoArg (unSetGeneralFlag Opt_PIC))
------ Debugging flags ----------------------------------------------
, make_ord_flag defGhcFlag "g" (OptIntSuffix setDebugLevel)
@@ -5007,8 +5018,10 @@ setOptHpcDir arg = upd $ \ d -> d {hpcDir = arg}
-- platform.
picCCOpts :: DynFlags -> [String]
-picCCOpts dflags
- = case platformOS (targetPlatform dflags) of
+picCCOpts dflags = pieOpts ++ picOpts
+ where
+ picOpts =
+ case platformOS (targetPlatform dflags) of
OSDarwin
-- Apple prefers to do things the other way round.
-- PIC is on by default.
@@ -5033,6 +5046,23 @@ picCCOpts dflags
["-fPIC", "-U__PIC__", "-D__PIC__"]
| otherwise -> []
+ pieOpts
+ | gopt Opt_PICExecutable dflags = ["-pie"]
+ -- See Note [No PIE when linking]
+ | sGccSupportsNoPie (settings dflags) = ["-no-pie"]
+ | otherwise = []
+
+
+{-
+Note [No PIE while linking]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
+default in their gcc builds. This is incompatible with -r as it implies that we
+are producing an executable. Consequently, we must manually pass -no-pie to gcc
+when joining object files or linking dynamic libraries. Unless, of course, the
+user has explicitly requested a PIE executable with -pie. See #12759.
+-}
+
picPOpts :: DynFlags -> [String]
picPOpts dflags
| gopt Opt_PIC dflags = ["-U__PIC__", "-D__PIC__"]
@@ -5203,6 +5233,9 @@ makeDynFlagsConsistent dflags
= let dflags' = dflags { hscTarget = HscLlvm }
warn = "No native code generator, so using LLVM"
in loop dflags' warn
+ | not (osElfTarget os) && gopt Opt_PIE dflags
+ = loop (gopt_unset dflags Opt_PIE)
+ "Position-independent only supported on ELF platforms"
| os == OSDarwin &&
arch == ArchX86_64 &&
not (gopt Opt_PIC dflags)
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index faf6f11736..57d77a3a13 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -8,7 +8,7 @@
-----------------------------------------------------------------------------
-}
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
module SysTools (
-- Initialisation
@@ -1372,15 +1372,6 @@ linesPlatform xs =
#endif
-{-
-Note [No PIE eating while linking]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
-default in their gcc builds. This is incompatible with -r as it implies that we
-are producing an executable. Consequently, we must manually pass -no-pie to gcc
-when joining object files or linking dynamic libraries. See #12759.
--}
-
linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
linkDynLib dflags0 o_files dep_packages
= do
@@ -1547,10 +1538,6 @@ linkDynLib dflags0 o_files dep_packages
++ [ Option "-o"
, FileOption "" output_fn
]
- -- See Note [No PIE eating when linking]
- ++ (if sGccSupportsNoPie (settings dflags)
- then [Option "-no-pie"]
- else [])
++ map Option o_files
++ [ Option "-shared" ]
++ map Option bsymbolicFlag
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 45d170e28d..314d726b50 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -1212,15 +1212,15 @@ cmmExprNative referenceKind expr = do
-- to use the register table, so we replace these registers
-- with the corresponding labels:
CmmReg (CmmGlobal EagerBlackholeInfo)
- | arch == ArchPPC && not (gopt Opt_PIC dflags)
+ | arch == ArchPPC && not (positionIndependent dflags)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_EAGER_BLACKHOLE_info")))
CmmReg (CmmGlobal GCEnter1)
- | arch == ArchPPC && not (gopt Opt_PIC dflags)
+ | arch == ArchPPC && not (positionIndependent dflags)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_enter_1")))
CmmReg (CmmGlobal GCFun)
- | arch == ArchPPC && not (gopt Opt_PIC dflags)
+ | arch == ArchPPC && not (positionIndependent dflags)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_fun")))
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index bef0a21235..de1fbaa8d4 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -176,7 +176,7 @@ cmmMakePicReference dflags lbl
(platformOS $ targetPlatform dflags)
lbl ]
- | (gopt Opt_PIC dflags || WayDyn `elem` ways dflags) && absoluteLabel lbl
+ | (positionIndependent dflags || WayDyn `elem` ways dflags) && absoluteLabel lbl
= CmmMachOp (MO_Add (wordWidth dflags))
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative
@@ -272,7 +272,7 @@ howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
-- we'd need to pass the current Module all the way in to
-- this function.
| arch /= ArchX86_64
- , gopt Opt_PIC dflags && externallyVisibleCLabel lbl
+ , positionIndependent dflags && externallyVisibleCLabel lbl
= AccessViaSymbolPtr
| otherwise
@@ -313,8 +313,8 @@ howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl
--
-- ELF tries to pretend to the main application code that dynamic linking does
-- not exist. While this may sound convenient, it tends to mess things up in
--- very bad ways, so we have to be careful when we generate code for the main
--- program (-dynamic but no -fPIC).
+-- very bad ways, so we have to be careful when we generate code for a non-PIE
+-- main program (-dynamic but no -fPIC).
--
-- Indirect access is required for references to imported symbols
-- from position independent code. It is also required from the main program
@@ -337,7 +337,7 @@ howToAccessLabel dflags _ os _ _ _
-- if we don't dynamically link to Haskell code,
-- it actually manages to do so without messing things up.
| osElfTarget os
- , not (gopt Opt_PIC dflags) && WayDyn `notElem` ways dflags
+ , not (positionIndependent dflags) && WayDyn `notElem` ways dflags
= AccessDirectly
howToAccessLabel dflags arch os this_mod DataReference lbl
@@ -351,7 +351,7 @@ howToAccessLabel dflags arch os this_mod DataReference lbl
-- via a symbol pointer (see below for an explanation why
-- PowerPC32 Linux is especially broken).
| arch == ArchPPC
- , gopt Opt_PIC dflags
+ , positionIndependent dflags
-> AccessViaSymbolPtr
| otherwise
@@ -372,12 +372,13 @@ howToAccessLabel dflags arch os this_mod DataReference lbl
howToAccessLabel dflags arch os this_mod CallReference lbl
| osElfTarget os
- , labelDynamic dflags this_mod lbl && not (gopt Opt_PIC dflags)
+ , labelDynamic dflags this_mod lbl && not (positionIndependent dflags)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
- , labelDynamic dflags this_mod lbl && gopt Opt_PIC dflags
+ , labelDynamic dflags this_mod lbl
+ , positionIndependent dflags
= AccessViaStub
howToAccessLabel dflags _ os this_mod _ lbl
@@ -388,7 +389,7 @@ howToAccessLabel dflags _ os this_mod _ lbl
-- all other platforms
howToAccessLabel dflags _ _ _ _ _
- | not (gopt Opt_PIC dflags)
+ | not (positionIndependent dflags)
= AccessDirectly
| otherwise
@@ -467,7 +468,7 @@ needImportedSymbols dflags arch os
-- PowerPC Linux: -fPIC or -dynamic
| osElfTarget os
, arch == ArchPPC
- = gopt Opt_PIC dflags || WayDyn `elem` ways dflags
+ = positionIndependent dflags || WayDyn `elem` ways dflags
-- PowerPC 64 Linux: always
| osElfTarget os
@@ -477,7 +478,7 @@ needImportedSymbols dflags arch os
-- i386 (and others?): -dynamic but not -fPIC
| osElfTarget os
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
- = WayDyn `elem` ways dflags && not (gopt Opt_PIC dflags)
+ = WayDyn `elem` ways dflags && not (positionIndependent dflags)
| otherwise
= False
@@ -499,7 +500,7 @@ gotLabel
-- However, for PIC on x86, we need a small helper function.
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration dflags ArchX86 OSDarwin
- | gopt Opt_PIC dflags
+ | positionIndependent dflags
= vcat [
text ".section __TEXT,__textcoal_nt,coalesced,no_toc",
text ".weak_definition ___i686.get_pc_thunk.ax",
@@ -540,7 +541,7 @@ pprGotDeclaration _ (ArchPPC_64 _) _
pprGotDeclaration dflags arch os
| osElfTarget os
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
- , not (gopt Opt_PIC dflags)
+ , not (positionIndependent dflags)
= empty
| osElfTarget os
@@ -565,7 +566,7 @@ pprGotDeclaration _ _ _
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
- = case gopt Opt_PIC dflags of
+ = case positionIndependent dflags of
False ->
vcat [
text ".symbol_stub",
@@ -619,7 +620,7 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS
pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
- = case gopt Opt_PIC dflags of
+ = case positionIndependent dflags of
False ->
vcat [
text ".symbol_stub",
@@ -652,7 +653,7 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
text "\tjmp dyld_stub_binding_helper"
]
$+$ vcat [ text ".section __DATA, __la_sym_ptr"
- <> (if gopt Opt_PIC dflags then int 2 else int 3)
+ <> (if positionIndependent dflags then int 2 else int 3)
<> text ",lazy_symbol_pointers",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 1e88a1d025..1a802d34b2 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -1598,7 +1598,7 @@ genCCall' dflags gcp target dest_regs args
uses_pic_base_implicitly = do
-- See Note [implicit register in PPC PIC code]
-- on why we claim to use PIC register here
- when (gopt Opt_PIC dflags && target32Bit platform) $ do
+ when (positionIndependent dflags && target32Bit platform) $ do
_ <- getPicBaseNat $ archWordFormat True
return ()
@@ -1950,7 +1950,7 @@ genSwitch dflags expr targets
]
return code
- | (gopt Opt_PIC dflags) || (not $ target32Bit $ targetPlatform dflags)
+ | (positionIndependent dflags) || (not $ target32Bit $ targetPlatform dflags)
= do
(reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
let fmt = archWordFormat $ target32Bit $ targetPlatform dflags
@@ -1988,7 +1988,7 @@ generateJumpTableForInstr :: DynFlags -> Instr
-> Maybe (NatCmmDecl CmmStatics Instr)
generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
let jumpTable
- | (gopt Opt_PIC dflags)
+ | (positionIndependent dflags)
|| (not $ target32Bit $ targetPlatform dflags)
= map jumpTableEntryRel ids
| otherwise = map (jumpTableEntry dflags) ids
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 71d320fa63..72e25b945f 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -313,7 +313,7 @@ genCondJump bid bool = do
genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch dflags expr targets
- | gopt Opt_PIC dflags
+ | positionIndependent dflags
= error "MachCodeGen: sparc genSwitch PIC not finished\n"
| otherwise
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index bd4774ae2c..8f7fbd292b 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -2696,7 +2696,7 @@ outOfLineCmmOp mop res args
genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch dflags expr targets
- | gopt Opt_PIC dflags
+ | positionIndependent dflags
= do
(reg,e_code) <- getNonClobberedReg (cmmOffset dflags expr offset)
-- getNonClobberedReg because it needs to survive across t_code
@@ -2759,7 +2759,7 @@ createJumpTable :: DynFlags -> [Maybe BlockId] -> Section -> CLabel
-> GenCmmDecl (Alignment, CmmStatics) h g
createJumpTable dflags ids section lbl
= let jumpTable
- | gopt Opt_PIC dflags =
+ | positionIndependent dflags =
let jumpTableEntryRel Nothing
= CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntryRel (Just blockid)
diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst
index 92e308db15..0b754621dd 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -1113,3 +1113,27 @@ for example).
aren't referenced by any other code linked into the executable.
If you're using ``-fwhole-archive-hs-libs``, you probably also
want ``-rdynamic``.
+
+.. ghc-flag:: -pie
+ :shortdesc: Instruct the linker to produce a position-independent executable.
+ :type: dynamic
+ :category: linking
+
+ :since: 8.2.1
+
+ This instructs the linker to produce a position-independent executable.
+ This flag is only valid while producing executables and all object code
+ being linked must have been produced with :ghc-flag:`-fPIE`.
+
+ Position independent executables are required by some platforms as they
+ enable address-space layout randomization (ASLR), a common security measure.
+ They can also be useful as they can be dynamically loaded and used as shared
+ libraries by other executables.
+
+ Position independent executables should be dynamically-linked (e.g. built
+ with :ghc-flag:`-dynamic` and only loaded into other dynamically-linked
+ executables to ensure that only one ``libHSrts`` is present if
+ loaded into the address space of another Haskell process.
+
+ Also, you may need to use the :ghc-flags:`-rdynamic` flag to ensure that
+ that symbols are not dropped from your PIE object.
diff --git a/docs/users_guide/shared_libs.rst b/docs/users_guide/shared_libs.rst
index 486df51ad9..7e525019ca 100644
--- a/docs/users_guide/shared_libs.rst
+++ b/docs/users_guide/shared_libs.rst
@@ -207,6 +207,10 @@ library directories of all the packages that the program depends on
paths. The unix tool ``readelf --dynamic`` is handy for inspecting the
``RPATH``/``RUNPATH`` entries in ELF shared libraries and executables.
+On most UNIX platforms it is also possible to build executables that can be
+``dlopen``\'d like shared libraries using the :ghc-flag:`-pie` flag during
+linking.
+
.. _finding-shared-libs-mac:
Mac OS X
diff --git a/testsuite/tests/dynlibs/Makefile b/testsuite/tests/dynlibs/Makefile
index 2f5620c73b..e3af7503e7 100644
--- a/testsuite/tests/dynlibs/Makefile
+++ b/testsuite/tests/dynlibs/Makefile
@@ -52,3 +52,9 @@ T5373:
-./T5373C +RTS -c 2>&1 | grep disabled
-./T5373D +RTS -c 2>&1 | grep disabled
+.PHONY: T13702
+T13702:
+ '$(TEST_HC)' -v0 -dynamic -rdynamic -fPIC -pie T13702.hs
+ '$(TEST_HC)' -v0 -dynamic T13702a.hs
+ ./T13702 # first make sure executable itself works
+ ./T13702a # then try dynamically loading it as library
diff --git a/testsuite/tests/dynlibs/T13702.hs b/testsuite/tests/dynlibs/T13702.hs
new file mode 100644
index 0000000000..5af4085c03
--- /dev/null
+++ b/testsuite/tests/dynlibs/T13702.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+main :: IO ()
+main = putStrLn "hello world"
+
+foreign export ccall "hello" hello :: IO ()
+
+hello :: IO ()
+hello = putStrLn "hello world again"
diff --git a/testsuite/tests/dynlibs/T13702.stdout b/testsuite/tests/dynlibs/T13702.stdout
new file mode 100644
index 0000000000..a2b2a712d0
--- /dev/null
+++ b/testsuite/tests/dynlibs/T13702.stdout
@@ -0,0 +1,2 @@
+hello world
+hello world again
diff --git a/testsuite/tests/dynlibs/T13702a.hs b/testsuite/tests/dynlibs/T13702a.hs
new file mode 100644
index 0000000000..5078852f6e
--- /dev/null
+++ b/testsuite/tests/dynlibs/T13702a.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Foreign
+import System.Posix.DynamicLinker
+
+main :: IO ()
+main = do
+ dl <- dlopen "./T13702" [RTLD_NOW]
+ funptr <- dlsym dl "hello" :: IO (FunPtr (IO ()))
+ mkAction funptr
+
+foreign import ccall "dynamic" mkAction :: FunPtr (IO ()) -> IO ()
diff --git a/testsuite/tests/dynlibs/all.T b/testsuite/tests/dynlibs/all.T
index 0713fe491e..88ce37f445 100644
--- a/testsuite/tests/dynlibs/all.T
+++ b/testsuite/tests/dynlibs/all.T
@@ -7,3 +7,7 @@ test('T4464', [req_shared_libs, unless(opsys('mingw32'), skip)], run_command,
test('T5373', [req_shared_libs], run_command,
['$MAKE --no-print-directory -s T5373'])
+
+# It's not clear exactly what platforms we can expect this to succeed on.
+test('T13702', unless(opsys('linux'), skip), run_command,
+ ['$MAKE --no-print-directory -s T13702'])
View Lorry Controller Status