summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/users_guide/8.0.2-notes.rst10
-rw-r--r--libraries/base/System/Posix/Internals.hs63
-rw-r--r--rts/Linker.c13
-rw-r--r--rts/RtsSymbols.c121
-rw-r--r--rts/RtsSymbols.h3
-rw-r--r--testsuite/tests/ffi/should_run/all.T6
-rw-r--r--testsuite/tests/rts/Makefile4
-rw-r--r--testsuite/tests/rts/T12497.hs24
-rw-r--r--testsuite/tests/rts/T12497.stdout2
-rw-r--r--testsuite/tests/rts/all.T5
10 files changed, 199 insertions, 52 deletions
diff --git a/docs/users_guide/8.0.2-notes.rst b/docs/users_guide/8.0.2-notes.rst
index 09ba5720a5..66cbe31c81 100644
--- a/docs/users_guide/8.0.2-notes.rst
+++ b/docs/users_guide/8.0.2-notes.rst
@@ -33,6 +33,16 @@ Compiler
initial cmm from STG-to-C-- code generation and :ghc-flag:`-ddump-cmm-verbose`
to obtain the intermediates from all C-- pipeline stages.
+Runtime system
+~~~~~~~~~~~~~~
+
+- The Runtime linker on Windows is once again recognizing POSIX functions under their
+ "deprecated" name. e.g. "strdup" will now be recognizes and internally forwarded to "_strdup".
+ If you have existing code already using the correct names (e.g. _strdup) then this will just continue
+ to work and no change is needed. For more information about how the forwarding is done please see
+ `MSDN <https://msdn.microsoft.com/en-us/library/ms235384.aspx>`_ . This should now introduce the same behavior
+ both compiled and interpreted. (see :ghc-ticket:`12497`).
+
- Added :ghc-flag:`-fdefer-out-of-scope-variables`, which converts variable
out of scope variables errors into warnings.
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index 630f251669..7bb26fa395 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -378,32 +378,35 @@ being done. See #11223
See https://msdn.microsoft.com/en-us/library/ms235384.aspx
for more.
+
+However since we can't hope to get people to support Windows
+packages we should support the deprecated names. See #12497
-}
-#if defined(mingw32_HOST_OS)
-foreign import ccall unsafe "io.h _lseeki64"
- c_lseek :: CInt -> Int64 -> CInt -> IO Int64
+foreign import capi unsafe "unistd.h lseek"
+ c_lseek :: CInt -> COff -> CInt -> IO COff
-foreign import ccall unsafe "HsBase.h _access"
+foreign import ccall unsafe "HsBase.h access"
c_access :: CString -> CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h _chmod"
+foreign import ccall unsafe "HsBase.h chmod"
c_chmod :: CString -> CMode -> IO CInt
-foreign import ccall unsafe "HsBase.h _close"
+foreign import ccall unsafe "HsBase.h close"
c_close :: CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h _creat"
+foreign import ccall unsafe "HsBase.h creat"
c_creat :: CString -> CMode -> IO CInt
-foreign import ccall unsafe "HsBase.h _dup"
+foreign import ccall unsafe "HsBase.h dup"
c_dup :: CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h _dup2"
+foreign import ccall unsafe "HsBase.h dup2"
c_dup2 :: CInt -> CInt -> IO CInt
-foreign import ccall unsafe "HsBase.h _isatty"
+foreign import ccall unsafe "HsBase.h isatty"
c_isatty :: CInt -> IO CInt
+#if defined(mingw32_HOST_OS)
-- See Note: Windows types
foreign import capi unsafe "HsBase.h _read"
c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt
@@ -423,44 +426,12 @@ foreign import capi unsafe "HsBase.h _write"
foreign import capi safe "HsBase.h _write"
c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt
-foreign import ccall unsafe "HsBase.h _unlink"
- c_unlink :: CString -> IO CInt
-
foreign import ccall unsafe "HsBase.h _pipe"
c_pipe :: Ptr CInt -> IO CInt
-
-foreign import capi unsafe "HsBase.h _utime"
- c_utime :: CString -> Ptr CUtimbuf -> IO CInt
-
-foreign import ccall unsafe "HsBase.h _getpid"
- c_getpid :: IO CPid
#else
-- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro
-- which redirects to the 64-bit-off_t versions when large file
-- support is enabled.
-foreign import capi unsafe "unistd.h lseek"
- c_lseek :: CInt -> COff -> CInt -> IO COff
-
-foreign import ccall unsafe "HsBase.h access"
- c_access :: CString -> CInt -> IO CInt
-
-foreign import ccall unsafe "HsBase.h chmod"
- c_chmod :: CString -> CMode -> IO CInt
-
-foreign import ccall unsafe "HsBase.h close"
- c_close :: CInt -> IO CInt
-
-foreign import ccall unsafe "HsBase.h creat"
- c_creat :: CString -> CMode -> IO CInt
-
-foreign import ccall unsafe "HsBase.h dup"
- c_dup :: CInt -> IO CInt
-
-foreign import ccall unsafe "HsBase.h dup2"
- c_dup2 :: CInt -> CInt -> IO CInt
-
-foreign import ccall unsafe "HsBase.h isatty"
- c_isatty :: CInt -> IO CInt
-- See Note: Windows types
foreign import capi unsafe "HsBase.h read"
@@ -481,18 +452,18 @@ foreign import capi unsafe "HsBase.h write"
foreign import capi safe "HsBase.h write"
c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
-foreign import ccall unsafe "HsBase.h unlink"
- c_unlink :: CString -> IO CInt
-
foreign import ccall unsafe "HsBase.h pipe"
c_pipe :: Ptr CInt -> IO CInt
+#endif
+
+foreign import ccall unsafe "HsBase.h unlink"
+ c_unlink :: CString -> IO CInt
foreign import capi unsafe "HsBase.h utime"
c_utime :: CString -> Ptr CUtimbuf -> IO CInt
foreign import ccall unsafe "HsBase.h getpid"
c_getpid :: IO CPid
-#endif
foreign import ccall unsafe "HsBase.h __hscore_stat"
c_stat :: CFilePath -> Ptr CStat -> IO CInt
diff --git a/rts/Linker.c b/rts/Linker.c
index b41bc1a641..f16fb83996 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -722,6 +722,7 @@ initLinker_ (int retain_cafs)
initMutex(&dl_mutex);
#endif
#endif
+
symhash = allocStrHashTable();
/* populate the symbol table with stuff from the RTS */
@@ -1369,6 +1370,18 @@ static SymbolAddr* lookupSymbol_ (SymbolName* lbl)
return NULL;
# endif
} else {
+#if defined(mingw32_HOST_OS)
+ // If Windows, perform initialization of uninitialized
+ // Symbols from the C runtime which was loaded above.
+ // We do this on lookup to prevent the hit when
+ // The symbol isn't being used.
+ if (pinfo->value == (void*)0xBAADF00D)
+ {
+ char symBuffer[50];
+ sprintf(symBuffer, "_%s", lbl);
+ pinfo->value = GetProcAddress(GetModuleHandle("msvcrt"), symBuffer);
+ }
+#endif
SymbolAddr* val = pinfo->value;
IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 605a669c21..13900367dc 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -86,8 +86,119 @@
RTS_WIN32_ONLY(SymI_HasProto(_imp___iob)) \
RTS_WIN64_ONLY(SymI_HasProto(__iob_func))
+#define RTS_MINGW_COMPAT_SYMBOLS \
+ SymI_HasProto_deprecated(access) \
+ SymI_HasProto_deprecated(cabs) \
+ SymI_HasProto_deprecated(cgets) \
+ SymI_HasProto_deprecated(chdir) \
+ SymI_HasProto_deprecated(chmod) \
+ SymI_HasProto_deprecated(chsize) \
+ SymI_HasProto_deprecated(close) \
+ SymI_HasProto_deprecated(cprintf) \
+ SymI_HasProto_deprecated(cputs) \
+ SymI_HasProto_deprecated(creat) \
+ SymI_HasProto_deprecated(cscanf) \
+ SymI_HasProto_deprecated(cwait) \
+ SymI_HasProto_deprecated(dup) \
+ SymI_HasProto_deprecated(dup2) \
+ SymI_HasProto_deprecated(ecvt) \
+ SymI_HasProto_deprecated(eof) \
+ SymI_HasProto_deprecated(execl) \
+ SymI_HasProto_deprecated(execle) \
+ SymI_HasProto_deprecated(execlp) \
+ SymI_HasProto_deprecated(execlpe) \
+ SymI_HasProto_deprecated(execv) \
+ SymI_HasProto_deprecated(execve) \
+ SymI_HasProto_deprecated(execvp) \
+ SymI_HasProto_deprecated(execvpe) \
+ SymI_HasProto_deprecated(fcloseall) \
+ SymI_HasProto_deprecated(fcvt) \
+ SymI_HasProto_deprecated(fdopen) \
+ SymI_HasProto_deprecated(fgetchar) \
+ SymI_HasProto_deprecated(filelength) \
+ SymI_HasProto_deprecated(fileno) \
+ SymI_HasProto_deprecated(flushall) \
+ SymI_HasProto_deprecated(fputchar) \
+ SymI_HasProto_deprecated(gcvt) \
+ SymI_HasProto_deprecated(getch) \
+ SymI_HasProto_deprecated(getche) \
+ SymI_HasProto_deprecated(getcwd) \
+ SymI_HasProto_deprecated(getpid) \
+ SymI_HasProto_deprecated(getw) \
+ SymI_HasProto_deprecated(hypot) \
+ SymI_HasProto_deprecated(inp) \
+ SymI_HasProto_deprecated(inpw) \
+ SymI_HasProto_deprecated(isascii) \
+ SymI_HasProto_deprecated(isatty) \
+ SymI_HasProto_deprecated(iscsym) \
+ SymI_HasProto_deprecated(iscsymf) \
+ SymI_HasProto_deprecated(itoa) \
+ SymI_HasProto_deprecated(j0) \
+ SymI_HasProto_deprecated(j1) \
+ SymI_HasProto_deprecated(jn) \
+ SymI_HasProto_deprecated(kbhit) \
+ SymI_HasProto_deprecated(lfind) \
+ SymI_HasProto_deprecated(locking) \
+ SymI_HasProto_deprecated(lsearch) \
+ SymI_HasProto_deprecated(lseek) \
+ SymI_HasProto_deprecated(ltoa) \
+ SymI_HasProto_deprecated(memccpy) \
+ SymI_HasProto_deprecated(memicmp) \
+ SymI_HasProto_deprecated(mkdir) \
+ SymI_HasProto_deprecated(mktemp) \
+ SymI_HasProto_deprecated(open) \
+ SymI_HasProto_deprecated(outp) \
+ SymI_HasProto_deprecated(outpw) \
+ SymI_HasProto_deprecated(putch) \
+ SymI_HasProto_deprecated(putenv) \
+ SymI_HasProto_deprecated(putw) \
+ SymI_HasProto_deprecated(read) \
+ SymI_HasProto_deprecated(rmdir) \
+ SymI_HasProto_deprecated(rmtmp) \
+ SymI_HasProto_deprecated(setmode) \
+ SymI_HasProto_deprecated(sopen) \
+ SymI_HasProto_deprecated(spawnl) \
+ SymI_HasProto_deprecated(spawnle) \
+ SymI_HasProto_deprecated(spawnlp) \
+ SymI_HasProto_deprecated(spawnlpe) \
+ SymI_HasProto_deprecated(spawnv) \
+ SymI_HasProto_deprecated(spawnve) \
+ SymI_HasProto_deprecated(spawnvp) \
+ SymI_HasProto_deprecated(spawnvpe) \
+ SymI_HasProto_deprecated(strcmpi) \
+ SymI_HasProto_deprecated(strdup) \
+ SymI_HasProto_deprecated(stricmp) \
+ SymI_HasProto_deprecated(strlwr) \
+ SymI_HasProto_deprecated(strnicmp) \
+ SymI_HasProto_deprecated(strnset) \
+ SymI_HasProto_deprecated(strrev) \
+ SymI_HasProto_deprecated(strset) \
+ SymI_HasProto_deprecated(strupr) \
+ SymI_HasProto_deprecated(swab) \
+ SymI_HasProto_deprecated(tell) \
+ SymI_HasProto_deprecated(tempnam) \
+ SymI_HasProto_deprecated(toascii) \
+ SymI_HasProto_deprecated(tzset) \
+ SymI_HasProto_deprecated(ultoa) \
+ SymI_HasProto_deprecated(umask) \
+ SymI_HasProto_deprecated(ungetch) \
+ SymI_HasProto_deprecated(unlink) \
+ SymI_HasProto_deprecated(wcsdup) \
+ SymI_HasProto_deprecated(wcsicmp) \
+ SymI_HasProto_deprecated(wcsicoll) \
+ SymI_HasProto_deprecated(wcslwr) \
+ SymI_HasProto_deprecated(wcsnicmp) \
+ SymI_HasProto_deprecated(wcsnset) \
+ SymI_HasProto_deprecated(wcsrev) \
+ SymI_HasProto_deprecated(wcsset) \
+ SymI_HasProto_deprecated(wcsupr) \
+ SymI_HasProto_deprecated(write) \
+ SymI_HasProto_deprecated(y0) \
+ SymI_HasProto_deprecated(y1) \
+ SymI_HasProto_deprecated(yn)
#else
#define RTS_MINGW_ONLY_SYMBOLS /**/
+#define RTS_MINGW_COMPAT_SYMBOLS /**/
#endif
@@ -804,6 +915,7 @@
#endif
#define SymI_HasProto(vvv) /**/
#define SymI_HasProto_redirect(vvv,xxx) /**/
+#define SymI_HasProto_deprecated(vvv) /**/
RTS_SYMBOLS
RTS_RET_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
@@ -816,6 +928,7 @@ RTS_LIBFFI_SYMBOLS
#undef SymI_NeedsDataProto
#undef SymI_HasProto
#undef SymI_HasProto_redirect
+#undef SymI_HasProto_deprecated
#undef SymE_HasProto
#undef SymE_HasDataProto
#undef SymE_NeedsProto
@@ -841,11 +954,19 @@ RTS_LIBFFI_SYMBOLS
{ MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
(void*)(&(xxx)) },
+// SymI_HasProto_deprecated allows us to redirect references from their deprecated
+// names to the undeprecated ones. e.g. access -> _access.
+// We use the hexspeak for unallocated memory 0xBAADF00D to signal the RTS
+// that this needs to be loaded from somewhere else.
+#define SymI_HasProto_deprecated(vvv) \
+ { #vvv, (void*)0xBAADF00D },
+
RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_RET_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
+ RTS_MINGW_COMPAT_SYMBOLS
RTS_DARWIN_ONLY_SYMBOLS
RTS_OPENBSD_ONLY_SYMBOLS
RTS_LIBGCC_SYMBOLS
diff --git a/rts/RtsSymbols.h b/rts/RtsSymbols.h
index e685a9dec1..b8201636b0 100644
--- a/rts/RtsSymbols.h
+++ b/rts/RtsSymbols.h
@@ -25,7 +25,6 @@ typedef struct _RtsSymbolVal {
SymbolAddr* addr;
} RtsSymbolVal;
-
-extern RtsSymbolVal rtsSyms[];
+extern RtsSymbolVal rtsSyms[];
#endif /* RTS_SYMBOLS_H */
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 2b35a0fa63..eb27564693 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -82,8 +82,7 @@ test('ffi015', [ omit_ways(['ghci']), extra_clean(['ffi015_cbits.o']) ],
# GHCi can't handle foreign import "&"
test('ffi016', omit_ways(['ghci']), compile_and_run, [''])
-test('ffi017', when(opsys('mingw32'), expect_broken_for(12209, ['ghci'])),
- compile_and_run, [''])
+test('ffi017', normal, compile_and_run, [''])
test('ffi018', [ omit_ways(['ghci']), extra_clean(['ffi018_c.o']) ],
compile_and_run, ['ffi018_c.c'])
@@ -138,8 +137,7 @@ test('ffi020', [ omit_ways(prof_ways),
exit_code(1) ], compile_and_run, [''])
-test('ffi021', when(opsys('mingw32'), expect_broken_for(12209, ['ghci'])),
- compile_and_run, [''])
+test('ffi021', normal, compile_and_run, [''])
test('ffi022', normal, compile_and_run, [''])
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index d3231b862c..94f38fa73d 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -168,3 +168,7 @@ T11788:
"$(TEST_HC)" -c T11788.c -o T11788_obj.o
"$(AR)" rsT libT11788.a T11788_obj.o 2> /dev/null
echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T11788.hs -lT11788 -L"$(PWD)"
+
+ .PHONY: T12497
+T12497:
+ echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs
diff --git a/testsuite/tests/rts/T12497.hs b/testsuite/tests/rts/T12497.hs
new file mode 100644
index 0000000000..e649864842
--- /dev/null
+++ b/testsuite/tests/rts/T12497.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP #-}
+
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
+import Foreign.C.String
+
+foreign import WINDOWS_CCONV "_strdup" strdup :: CString -> IO CString
+foreign import WINDOWS_CCONV "strdup" strdup2 :: CString -> IO CString
+
+dupString :: String -> IO String
+dupString str = newCString str >>= strdup >>= peekCString
+
+dupString2 :: String -> IO String
+dupString2 str = newCString str >>= strdup2 >>= peekCString
+
+main =
+ do print =<< dupString "Hello World!"
+ print =<< dupString2 "Hello Again World!"
diff --git a/testsuite/tests/rts/T12497.stdout b/testsuite/tests/rts/T12497.stdout
new file mode 100644
index 0000000000..03d0e237d0
--- /dev/null
+++ b/testsuite/tests/rts/T12497.stdout
@@ -0,0 +1,2 @@
+"Hello World!"
+"Hello Again World!"
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 27e78099af..b82036f565 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -365,3 +365,8 @@ test('T10296b', [only_ways('threaded2')], compile_and_run, [''])
test('numa001', [ extra_run_opts('8'), extra_ways(['debug_numa']) ]
, compile_and_run, [''])
+
+test('T12497', [ unless(opsys('mingw32'), skip)
+ ],
+ run_command, ['$MAKE -s --no-print-directory T12497'])
+
View Lorry Controller Status