Add support for producing position-independent executables
authorBen Gamari <bgamari.foss@gmail.com>
Tue, 22 Aug 2017 15:41:47 +0000 (11:41 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 22 Aug 2017 22:01:05 +0000 (18:01 -0400)
Previously due to #12759 we disabled PIE support entirely. However, this
breaks the user's ability to produce PIEs. Add an explicit flag, -fPIE,
allowing the user to build PIEs.

Test Plan: Validate

Reviewers: rwbarton, austin, simonmar

Subscribers: trommler, simonmar, trofi, jrtc27, thomie

GHC Trac Issues: #12759, #13702

Differential Revision: https://phabricator.haskell.org/D3589

17 files changed:
compiler/cmm/CmmPipeline.hs
compiler/codeGen/StgCmmCon.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/SysTools.hs
compiler/nativeGen/AsmCodeGen.hs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/X86/CodeGen.hs
docs/users_guide/phases.rst
docs/users_guide/shared_libs.rst
testsuite/tests/dynlibs/Makefile
testsuite/tests/dynlibs/T13702.hs [new file with mode: 0644]
testsuite/tests/dynlibs/T13702.stdout [new file with mode: 0644]
testsuite/tests/dynlibs/T13702a.hs [new file with mode: 0644]
testsuite/tests/dynlibs/all.T

index bc827df..edcaf7b 100644 (file)
@@ -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
index a76b8cc..6438b8c 100644 (file)
@@ -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
index 7f70377..d94cbb4 100644 (file)
@@ -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 [])
index 590d834..d51f434 100644 (file)
@@ -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)
index faf6f11..57d77a3 100644 (file)
@@ -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
index 45d170e..314d726 100644 (file)
@@ -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")))
 
index bef0a21..de1fbaa 100644 (file)
@@ -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,
index 1e88a1d..1a802d3 100644 (file)
@@ -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
index 71d320f..72e25b9 100644 (file)
@@ -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
index bd4774a..8f7fbd2 100644 (file)
@@ -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)
index 92e308d..0b75462 100644 (file)
@@ -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.
index 486df51..7e52501 100644 (file)
@@ -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
index 2f5620c..e3af750 100644 (file)
@@ -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 (file)
index 0000000..5af4085
--- /dev/null
@@ -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 (file)
index 0000000..a2b2a71
--- /dev/null
@@ -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 (file)
index 0000000..5078852
--- /dev/null
@@ -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 ()
index 0713fe4..88ce37f 100644 (file)
@@ -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'])