[perl #112272] return EEXIST on link() to an existing file

Also attempts to translate some other errors.

Unfortunately Microsoft don't document error codes.

2 files changed, 31 insertions, 2 deletions

diff --git a/t/win32/fs.t b/t/win32/fs.t
index 0369f4153b..cbe697c459 100644
--- a/t/win32/fs.t
+++ b/t/win32/fs.t
@@ -32,7 +32,6 @@ SKIP: {
     ok(!link($tmpfile1, $tmpfile2),
        "Cannot link to existing file");
     warn $!;
-    local $TODO = "not yet implemented";
     is(0+$!, &Errno::EEXIST, "check for EEXIST");
 }
 
diff --git a/win32/win32.c b/win32/win32.c
index 89413fc28c..7f2444b178 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2925,7 +2925,37 @@ win32_link(const char *oldname, const char *newname)
     {
 	return 0;
     }
-    errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
+    /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for
+       both permissions errors and if the source is a directory, while
+       POSIX wants EACCES and EPERM respectively.
+
+       Determined by experimentation on Windows 7 x64 SP1, since MS
+       don't document what error codes are returned.
+    */
+    switch (GetLastError()) {
+    case ERROR_BAD_NET_NAME:
+    case ERROR_BAD_NETPATH:
+    case ERROR_BAD_PATHNAME:
+    case ERROR_FILE_NOT_FOUND:
+    case ERROR_FILENAME_EXCED_RANGE:
+    case ERROR_INVALID_DRIVE:
+    case ERROR_PATH_NOT_FOUND:
+      errno = ENOENT;
+      break;
+    case ERROR_ALREADY_EXISTS:
+      errno = EEXIST;
+      break;
+    case ERROR_ACCESS_DENIED:
+      errno = EACCES;
+      break;
+    case ERROR_NOT_SAME_DEVICE:
+      errno = EXDEV;
+      break;
+    default:
+      /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */
+      errno = EINVAL;
+      break;
+    }
     return -1;
 }