diff options
| -rw-r--r-- | compiler/ghci/Linker.hs | 86 | ||||
| -rw-r--r-- | compiler/ghci/ObjLink.hs | 47 | ||||
| -rw-r--r-- | includes/rts/Linker.h | 11 | ||||
| -rw-r--r-- | rts/Linker.c | 199 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 4 | ||||
| -rw-r--r-- | rts/ghc.mk | 15 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/B.c | 21 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/Makefile | 45 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/T10955.script | 5 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/T10955.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/T10955dyn.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/T10955dyn.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/ghci/linking/dyn/all.T | 26 |
13 files changed, 386 insertions, 82 deletions
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 9fa89fec5e..13085090ef 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -299,39 +299,47 @@ linkCmdLineLibs dflags = do linkCmdLineLibs' :: DynFlags -> PersistentLinkerState -> IO PersistentLinkerState linkCmdLineLibs' dflags@(DynFlags { ldInputs = cmdline_ld_inputs , libraryPaths = lib_paths}) pls = - do { -- (c) Link libraries from the command-line - ; let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ] - ; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls - - -- (d) Link .o files from the command-line - ; classified_ld_inputs <- mapM (classifyLdInput dflags) - [ f | FileOption _ f <- cmdline_ld_inputs ] - - -- (e) Link any MacOS frameworks - ; let platform = targetPlatform dflags - ; let (framework_paths, frameworks) = - if platformUsesFrameworks platform - then (frameworkPaths dflags, cmdlineFrameworks dflags) - else ([],[]) - - -- Finally do (c),(d),(e) - ; let cmdline_lib_specs = catMaybes classified_ld_inputs - ++ libspecs - ++ map Framework frameworks - ; if null cmdline_lib_specs then return pls - else do - - { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls - cmdline_lib_specs - ; maybePutStr dflags "final link ... " - ; ok <- resolveObjs - - ; if succeeded ok then maybePutStrLn dflags "done" - else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed") - - ; return pls1 - }} - + do -- (c) Link libraries from the command-line + let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ] + libspecs <- mapM (locateLib dflags False lib_paths) minus_ls + + -- (d) Link .o files from the command-line + classified_ld_inputs <- mapM (classifyLdInput dflags) + [ f | FileOption _ f <- cmdline_ld_inputs ] + + -- (e) Link any MacOS frameworks + let platform = targetPlatform dflags + let (framework_paths, frameworks) = + if platformUsesFrameworks platform + then (frameworkPaths dflags, cmdlineFrameworks dflags) + else ([],[]) + + -- Finally do (c),(d),(e) + let cmdline_lib_specs = catMaybes classified_ld_inputs + ++ libspecs + ++ map Framework frameworks + if null cmdline_lib_specs then return pls + else do + + -- Add directories to library search paths + let all_paths = let paths = framework_paths + ++ lib_paths + ++ [ takeDirectory dll | DLLPath dll <- libspecs ] + in nub $ map normalise paths + pathCache <- mapM addLibrarySearchPath all_paths + + pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls + cmdline_lib_specs + maybePutStr dflags "final link ... " + ok <- resolveObjs + + -- DLLs are loaded, reset the search paths + mapM_ removeLibrarySearchPath $ reverse pathCache + + if succeeded ok then maybePutStrLn dflags "done" + else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed") + + return pls1 {- Note [preload packages] @@ -1021,7 +1029,7 @@ data LibrarySpec | DLL String -- "Unadorned" name of a .DLL/.so -- e.g. On unix "qt" denotes "libqt.so" - -- On WinDoze "burble" denotes "burble.DLL" + -- On Windows "burble" denotes "burble.DLL" or "libburble.dll" -- loadDLL is platform-specific and adds the lib/.so/.DLL -- suffixes platform-dependently @@ -1115,7 +1123,7 @@ linkPackage dflags pkg -- Because of slight differences between the GHC dynamic linker and -- the native system linker some packages have to link with a -- different list of libraries when using GHCi. Examples include: libs - -- that are actually gnu ld scripts, and the possability that the .a + -- that are actually gnu ld scripts, and the possibility that the .a -- libs do not exactly match the .so/.dll equivalents. So if the -- package file provides an "extra-ghci-libraries" field then we use -- that instead of the "extra-libraries" field. @@ -1135,6 +1143,11 @@ linkPackage dflags pkg objs = [ obj | Object obj <- classifieds ] archs = [ arch | Archive arch <- classifieds ] + -- Add directories to library search paths + let dll_paths = map takeDirectory known_dlls + all_paths = nub $ map normalise $ dll_paths ++ dirs + pathCache <- mapM addLibrarySearchPath all_paths + maybePutStr dflags ("Loading package " ++ sourcePackageIdString pkg ++ " ... ") @@ -1143,6 +1156,9 @@ linkPackage dflags pkg loadFrameworks platform pkg mapM_ load_dyn (known_dlls ++ map (mkSOName platform) dlls) + -- DLLs are loaded, reset the search paths + mapM_ removeLibrarySearchPath $ reverse pathCache + -- After loading all the DLLs, we can load the static objects. -- Ordering isn't important here, because we do one final link -- step to resolve everything. diff --git a/compiler/ghci/ObjLink.hs b/compiler/ghci/ObjLink.hs index c9cf78cc4d..d5d4980387 100644 --- a/compiler/ghci/ObjLink.hs +++ b/compiler/ghci/ObjLink.hs @@ -9,14 +9,16 @@ -- | Primarily, this module consists of an interface to the C-land -- dynamic linker. module ObjLink ( - initObjLinker, -- :: IO () - loadDLL, -- :: String -> IO (Maybe String) - loadArchive, -- :: String -> IO () - loadObj, -- :: String -> IO () - unloadObj, -- :: String -> IO () - insertSymbol, -- :: String -> String -> Ptr a -> IO () - lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) - resolveObjs -- :: IO SuccessFlag + initObjLinker, -- :: IO () + loadDLL, -- :: String -> IO (Maybe String) + loadArchive, -- :: String -> IO () + loadObj, -- :: String -> IO () + unloadObj, -- :: String -> IO () + insertSymbol, -- :: String -> String -> Ptr a -> IO () + lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) + resolveObjs, -- :: IO SuccessFlag + addLibrarySearchPath, -- :: CFilePath -> IO (Ptr ()) + removeLibrarySearchPath -- :: Ptr() -> IO Bool ) where import Panic @@ -29,7 +31,7 @@ import Foreign.C import Foreign ( nullPtr ) import GHC.Exts ( Ptr(..) ) import System.Posix.Internals ( CFilePath, withFilePath ) -import System.FilePath ( dropExtension ) +import System.FilePath ( dropExtension, normalise ) -- --------------------------------------------------------------------------- @@ -75,7 +77,7 @@ loadDLL str0 = do str | isWindowsHost = dropExtension str0 | otherwise = str0 -- - maybe_errmsg <- withFilePath str $ \dll -> c_addDLL dll + maybe_errmsg <- withFilePath (normalise str) $ \dll -> c_addDLL dll if maybe_errmsg == nullPtr then return Nothing else do str <- peekCString maybe_errmsg @@ -99,6 +101,13 @@ unloadObj str = r <- c_unloadObj c_str when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed")) +addLibrarySearchPath :: String -> IO (Ptr ()) +addLibrarySearchPath str = + withFilePath str c_addLibrarySearchPath + +removeLibrarySearchPath :: Ptr () -> IO Bool +removeLibrarySearchPath = c_removeLibrarySearchPath + resolveObjs :: IO SuccessFlag resolveObjs = do r <- c_resolveObjs @@ -108,11 +117,13 @@ resolveObjs = do -- Foreign declarations to RTS entry points which does the real work; -- --------------------------------------------------------------------------- -foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString -foreign import ccall unsafe "initLinker" initObjLinker :: IO () -foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CFilePath -> CString -> Ptr a -> IO () -foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) -foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int -foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int -foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int -foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int +foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString +foreign import ccall unsafe "initLinker" initObjLinker :: IO () +foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CFilePath -> CString -> Ptr a -> IO () +foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) +foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int +foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int +foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int +foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int +foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ()) +foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr() -> IO Bool diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h index a0891f46f7..47a5820bfb 100644 --- a/includes/rts/Linker.h +++ b/includes/rts/Linker.h @@ -66,6 +66,17 @@ HsInt resolveObjs( void ); /* load a dynamic library */ const char *addDLL( pathchar* dll_name ); +/* add a path to the library search path */ +HsPtr addLibrarySearchPath(pathchar* dll_path); + +/* removes a directory from the search path, + path must have been added using addLibrarySearchPath */ +HsBool removeLibrarySearchPath(HsPtr dll_path_index); + +/* give a warning about missing Windows patches that would make + the linker work better */ +void warnMissingKBLibraryPaths( void ); + /* called by the initialization code for a module, not a user API */ StgStablePtr foreignExportStablePtr (StgPtr p); diff --git a/rts/Linker.c b/rts/Linker.c index 0507c9c268..35227c866b 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -104,6 +104,7 @@ # include <windows.h> # include <shfolder.h> /* SHGetFolderPathW */ # include <math.h> +# include <wchar.h> #elif defined(darwin_HOST_OS) # define OBJFORMAT_MACHO # include <regex.h> @@ -246,6 +247,12 @@ static void machoInitSymbolsWithoutUnderscore( void ); #endif #endif +#if defined(OBJFORMAT_PEi386) +// MingW-w64 is missing these from the implementation. So we have to look them up +typedef DLL_DIRECTORY_COOKIE(*LPAddDLLDirectory)(PCWSTR NewDirectory); +typedef WINBOOL(*LPRemoveDLLDirectory)(DLL_DIRECTORY_COOKIE Cookie); +#endif + static void freeProddableBlocks (ObjectCode *oc); #if USE_MMAP @@ -832,7 +839,7 @@ addDLL( pathchar *dll_name ) OpenedDLL* o_dll; HINSTANCE instance; - /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */ + IF_DEBUG(linker, debugBelch("\naddDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); /* See if we've already got it, and ignore if so. */ for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { @@ -852,23 +859,46 @@ addDLL( pathchar *dll_name ) size_t bufsize = pathlen(dll_name) + 10; buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); - snwprintf(buf, bufsize, L"%s.DLL", dll_name); - instance = LoadLibraryW(buf); - if (instance == NULL) { - if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error; - // KAA: allow loading of drivers (like winspool.drv) - snwprintf(buf, bufsize, L"%s.DRV", dll_name); - instance = LoadLibraryW(buf); - if (instance == NULL) { - if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error; - // #1883: allow loading of unix-style libfoo.dll DLLs - snwprintf(buf, bufsize, L"lib%s.DLL", dll_name); - instance = LoadLibraryW(buf); - if (instance == NULL) { - goto error; + + /* These are ordered by probability of success and order we'd like them */ + const wchar_t *formats[] = { L"%s.DLL", L"%s.DRV", L"lib%s.DLL", L"%s" }; + const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 }; + + int cFormat; + int cFlag; + int flags_start = 1; // Assume we don't support the new API + + /* Detect if newer API are available, if not, skip the first flags entry */ + if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) { + flags_start = 0; + } + + /* Iterate through the possible flags and formats */ + for (cFlag = flags_start; cFlag < 2; cFlag++) + { + for (cFormat = 0; cFormat < 4; cFormat++) + { + snwprintf(buf, bufsize, formats[cFormat], dll_name); + instance = LoadLibraryExW(buf, NULL, flags[cFlag]); + if (instance == NULL) + { + if (GetLastError() != ERROR_MOD_NOT_FOUND) + { + goto error; + } + } + else + { + break; // We're done. DLL has been loaded. } } } + + // Check if we managed to load the DLL + if (instance == NULL) { + goto error; + } + stgFree(buf); addDLLHandle(dll_name, instance); @@ -877,7 +907,7 @@ addDLL( pathchar *dll_name ) error: stgFree(buf); - sysErrorBelch("%" PATH_FMT, dll_name); + sysErrorBelch("addDLL: %" PATH_FMT " (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return "addDLL: could not load DLL"; @@ -887,6 +917,142 @@ error: # endif } + +/* ----------------------------------------------------------------------------- +* Emits a warning determining that the system is missing a required security +* update that we need to get access to the proper APIs +*/ +void warnMissingKBLibraryPaths( void ) +{ + static HsBool missing_update_warn = HS_BOOL_FALSE; + if (!missing_update_warn) { + debugBelch("Warning: If linking fails, consider installing KB2533623.\n"); + missing_update_warn = HS_BOOL_TRUE; + } +} + +/* ----------------------------------------------------------------------------- +* appends a directory to the process DLL Load path so LoadLibrary can find it +* +* Returns: NULL on failure, or pointer to be passed to removeLibrarySearchPath to +* restore the search path to what it was before this call. +*/ +HsPtr addLibrarySearchPath(pathchar* dll_path) +{ + IF_DEBUG(linker, debugBelch("\naddLibrarySearchPath: dll_path = `%" PATH_FMT "'\n", dll_path)); + +#if defined(OBJFORMAT_PEi386) + HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL"); + LPAddDLLDirectory AddDllDirectory = (LPAddDLLDirectory)GetProcAddress((HMODULE)hDLL, "AddDllDirectory"); + + HsPtr result = NULL; + + const unsigned int init_buf_size = 4096; + int bufsize = init_buf_size; + + // Make sure the path is an absolute path + WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); + if (!wResult){ + sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()); + } + else if (wResult > init_buf_size) { + abs_path = realloc(abs_path, sizeof(WCHAR) * wResult); + if (!GetFullPathNameW(dll_path, bufsize, abs_path, NULL)) { + sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()); + } + } + + if (AddDllDirectory) { + result = AddDllDirectory(abs_path); + } + else + { + warnMissingKBLibraryPaths(); + WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); + + if (wResult > init_buf_size) { + str = realloc(str, sizeof(WCHAR) * wResult); + bufsize = wResult; + wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); + if (!wResult) { + sysErrorBelch("addLibrarySearchPath[GetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()); + } + } + + bufsize = wResult + 2 + pathlen(abs_path); + wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + + wcscpy(newPath, abs_path); + wcscat(newPath, L";"); + wcscat(newPath, str); + if (!SetEnvironmentVariableW(L"PATH", (LPCWSTR)newPath)) { + sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); + } + + free(newPath); + free(abs_path); + + return str; + } + + if (!result) { + sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); + free(abs_path); + return NULL; + } + + free(abs_path); + return result; +#else + (void)(dll_path); // Function not implemented for other platforms. + return NULL; +#endif +} + +/* ----------------------------------------------------------------------------- +* removes a directory from the process DLL Load path +* +* Returns: HS_BOOL_TRUE on success, otherwise HS_BOOL_FALSE +*/ +HsBool removeLibrarySearchPath(HsPtr dll_path_index) +{ + IF_DEBUG(linker, debugBelch("\nremoveLibrarySearchPath: ptr = `%p'\n", dll_path_index)); + +#if defined(OBJFORMAT_PEi386) + HsBool result = 0; + + if (dll_path_index != NULL) { + HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL"); + LPRemoveDLLDirectory RemoveDllDirectory = (LPRemoveDLLDirectory)GetProcAddress((HMODULE)hDLL, "RemoveDllDirectory"); + + if (RemoveDllDirectory) { + result = RemoveDllDirectory(dll_path_index); + // dll_path_index is now invalid, do not use it after this point. + } + else + { + warnMissingKBLibraryPaths(); + + result = SetEnvironmentVariableW(L"PATH", (LPCWSTR)dll_path_index); + + free(dll_path_index); + } + + if (!result) { + sysErrorBelch("removeLibrarySearchPath: (Win32 error %lu)", GetLastError()); + return HS_BOOL_FALSE; + } + } + + return result == 0 ? HS_BOOL_TRUE : HS_BOOL_FALSE; +#else + (void)(dll_path_index); // Function not implemented for other platforms. + return HS_BOOL_FALSE; +#endif +} + /* ----------------------------------------------------------------------------- * insert a symbol in the hash table * @@ -2806,7 +2972,6 @@ typedef #define sizeof_COFF_reloc 10 - /* From PE spec doc, section 3.3.2 */ /* Note use of MYIMAGE_* since IMAGE_* are already defined in windows.h -- for the same purpose, but I want to know what I'm diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index 3a4355797e..0d15140d88 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -687,10 +687,12 @@ SymI_HasProto(stg_yield_to_interpreter) \ SymI_HasProto(stg_block_noregs) \ SymI_HasProto(stg_block_takemvar) \ - SymI_HasProto(stg_block_readmvar) \ + SymI_HasProto(stg_block_readmvar) \ SymI_HasProto(stg_block_putmvar) \ MAIN_CAP_SYM \ SymI_HasProto(addDLL) \ + SymI_HasProto(addLibrarySearchPath) \ + SymI_HasProto(removeLibrarySearchPath) \ SymI_HasProto(__int_encodeDouble) \ SymI_HasProto(__word_encodeDouble) \ SymI_HasProto(__int_encodeFloat) \ diff --git a/rts/ghc.mk b/rts/ghc.mk index 4b7f28ad89..c7c5e75831 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -19,6 +19,14 @@ rts_dist_HC = $(GHC_STAGE1) rts_INSTALL_INFO = rts rts_VERSION = 1.0 +# Minimum supported Windows version. +# These numbers can be found at: +# https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx +# If we're compiling on windows, enforce that we only support Vista SP1+ +# Adding this here means it doesn't have to be done in individual .c files +# and also centralizes the versioning. +rts_WINVER = 0x06000100 + # merge GhcLibWays and GhcRTSWays but strip out duplicates rts_WAYS = $(GhcLibWays) $(filter-out $(GhcLibWays),$(GhcRTSWays)) rts_dist_WAYS = $(rts_WAYS) @@ -184,7 +192,7 @@ rts_dist_$1_CC_OPTS += -DRtsWay=\"rts_$1\" # Adding this here means it doesn't have to be done in individual .c files # and also centralizes the versioning. ifeq "$$(TargetOS_CPP)" "mingw32" -rts_dist_$1_CC_OPTS += -DWINVER=0x0501 +rts_dist_$1_CC_OPTS += -DWINVER=$(rts_WINVER) endif ifneq "$$(UseSystemLibFFI)" "YES" @@ -321,6 +329,11 @@ ifeq "$(BeConservative)" "YES" rts_CC_OPTS += -DBE_CONSERVATIVE endif +# Set Windows version +ifeq "$$(TargetOS_CPP)" "mingw32" +rts_CC_OPTS += -DWINVER=$(rts_WINVER) +endif + #----------------------------------------------------------------------------- # Flags for compiling specific files rts/RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\" diff --git a/testsuite/tests/ghci/linking/dyn/B.c b/testsuite/tests/ghci/linking/dyn/B.c new file mode 100644 index 0000000000..0305b5e623 --- /dev/null +++ b/testsuite/tests/ghci/linking/dyn/B.c @@ -0,0 +1,21 @@ +#if defined(_MSC_VER) +// Microsoft +#define EXPORT __declspec(dllexport) +#define IMPORT __declspec(dllimport) +#elif defined(_GCC) +// GCC +#define EXPORT __attribute__((visibility("default"))) +#define IMPORT +#else +// do nothing and hope for the best? +#define EXPORT +#define IMPORT +#endif + +extern IMPORT int foo(); +extern EXPORT int bar(); + +EXPORT int bar() +{ + return foo() * foo(); +} diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile index 8a3b7363e4..cb3a564f54 100644 --- a/testsuite/tests/ghci/linking/dyn/Makefile +++ b/testsuite/tests/ghci/linking/dyn/Makefile @@ -10,14 +10,53 @@ else DLL = lib$1.so endif +ifeq "$(WINDOWS)" "YES" +EXE = $1.exe +else ifeq "$(DARWIN)" "YES" +EXE = $1 +else +EXE = $1 +endif + +ifeq "$(WINDOWS)" "YES" +CFLAGS = +else +CFLAGS = -fPIC +endif + +MY_TEST_HC_OPTS = $(filter-out -rtsopts,$(TEST_HC_OPTS)) $(CFLAGS) .PHONY: load_short_name load_short_name: rm -rf bin_short mkdir bin_short - gcc -shared A.c -o "bin_short/$(call DLL,A)" - echo ":q" | "$(TEST_HC)" --interactive -L"$(PWD)/bin_short" -lA -v0 + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared A.c -o "bin_short/$(call DLL,A)" + rm -f bin_short/*.a + echo ":q" | "$(TEST_HC)" --interactive -L"./bin_short" -lA -v0 .PHONY: compile_libAS compile_libAS: - gcc -shared A.c -o $(call DLL,AS) + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared A.c -o $(call DLL,AS) + rm -f libAS*.a + +.PHONY: compile_libAB_dep +compile_libAB_dep: + rm -rf bin_dep + mkdir bin_dep + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared A.c -o "bin_dep/$(call DLL,A)" + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared B.c -o "bin_dep/$(call DLL,B)" -lA -L"./bin_dep" + rm -f bin_dep/*.a + +.PHONY: compile_libAB_dyn +compile_libAB_dyn: + rm -rf bin_dyn + mkdir bin_dyn + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared A.c -o "bin_dyn/$(call DLL,A)" + '$(TEST_HC)' $(MY_TEST_HC_OPTS) -shared B.c -o "bin_dyn/$(call DLL,B)" -lA -L"./bin_dyn" + rm -f bin_dyn/*.a + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -v0 -o "bin_dyn/$(call EXE,T10955dyn)" -L./bin_dyn -lB -lA T10955dyn.hs -v0 + LD_LIBRARY_PATH=./bin_dyn ./bin_dyn/$(call EXE,T10955dyn) + +.PHONY: T1407 +T1407: + cat T1407.script | LD_LIBRARY_PATH=. "$(TEST_HC)" -ignore-dot-ghci -v0 --interactive -L. diff --git a/testsuite/tests/ghci/linking/dyn/T10955.script b/testsuite/tests/ghci/linking/dyn/T10955.script new file mode 100644 index 0000000000..e9470b4161 --- /dev/null +++ b/testsuite/tests/ghci/linking/dyn/T10955.script @@ -0,0 +1,5 @@ +:set -lB +import Foreign +import Foreign.C.Types +foreign import ccall "bar" dle :: IO CInt +dle diff --git a/testsuite/tests/ghci/linking/dyn/T10955.stdout b/testsuite/tests/ghci/linking/dyn/T10955.stdout new file mode 100644 index 0000000000..b8626c4cff --- /dev/null +++ b/testsuite/tests/ghci/linking/dyn/T10955.stdout @@ -0,0 +1 @@ +4 diff --git a/testsuite/tests/ghci/linking/dyn/T10955dyn.hs b/testsuite/tests/ghci/linking/dyn/T10955dyn.hs new file mode 100644 index 0000000000..948332aac7 --- /dev/null +++ b/testsuite/tests/ghci/linking/dyn/T10955dyn.hs @@ -0,0 +1,7 @@ +module Main where + +import Foreign +import Foreign.C.Types +foreign import ccall "bar" dle :: IO CInt + +main = dle >>= print diff --git a/testsuite/tests/ghci/linking/dyn/T10955dyn.stdout b/testsuite/tests/ghci/linking/dyn/T10955dyn.stdout new file mode 100644 index 0000000000..b8626c4cff --- /dev/null +++ b/testsuite/tests/ghci/linking/dyn/T10955dyn.stdout @@ -0,0 +1 @@ +4 diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index 2810c7f29f..abbc569a0f 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -1,12 +1,24 @@ test('load_short_name', - [unless(doing_ghci, skip), - extra_clean(['bin_short/*', 'bin_short'])], - run_command, - ['$MAKE -s --no-print-directory load_short_name']) + [unless(doing_ghci, skip), + extra_clean(['bin_short/*', 'bin_short'])], + run_command, + ['$MAKE -s --no-print-directory load_short_name']) test('T1407', - [unless(doing_ghci, skip), - extra_clean(['libAS.*']), + [unless(doing_ghci, skip), + extra_clean(['libAS.*']), pre_cmd('$MAKE -s --no-print-directory compile_libAS'), extra_hc_opts('-L.')], - ghci_script, ['T1407.script']) + run_command, ['$MAKE --no-print-directory -s T1407']) + +test('T10955', + [unless(doing_ghci, skip),unless(opsys('mingw32'), skip), + extra_clean(['bin_dep/*', 'bin_dep']), + pre_cmd('$MAKE -s --no-print-directory compile_libAB_dep'), + extra_hc_opts('-L. -L./bin_dep')], + ghci_script, ['T10955.script']) + +test('T10955dyn', + [extra_clean(['bin_dyn/*', 'bin_dyn'])], + run_command, + ['$MAKE -s --no-print-directory compile_libAB_dyn']) |