Added support for deprecated POSIX functions on Windows.

Summary:
With the introduction of 8.0.1 We've stopped supporting in GHCi
the use of POSIX functions under their deprecated names on Windows.

This to be compatible with object and libraries from the most
popular compilers on the platform (Microsoft and Intel compilers).

However this brings a confusing disparity between the compiled and
interpreted behavior since MingW-W64 does support the deprecated names.

Also It seems clear that package writers won't update their packages to
properly support Windows. As such I have added redirects in the RTS
for the deprecated functions as listed on

https://msdn.microsoft.com/en-us/library/ms235384.aspx.

This won't export the functions (as in, they won't be in the symbol table
of compiled code for the RTS.) but we inject them into the symbol table
of the dynamic linker at startup.

Test Plan:
./validate
and

make test TEST="ffi017 ffi021"

Reviewers: thomie, simonmar, RyanGlScott, bgamari, austin, hvr, erikd

Reviewed By: simonmar, bgamari

Subscribers: RyanGlScott, #ghc_windows_task_force

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

GHC Trac Issues: #12209, #12497, #12496

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'])
+