Unix.environment on Windows: use _wenviron (#1369)

* Unix.environment on Windows: use _wenviron

* Add Changes entry

* Update testsuite

- Add lib-unix/win-env/test_env.ml, a test that fails in trunk and passes in
  this PR.

- Add lib-unix/win-env/test_env2.ml: a test for MPR#4499 which is closely
  related to this PR.  Currently disabled as it fails.

- Added a new test in win-unicode/mltest.ml to test non-ASCII characters
  returned by Unix.environment (Unix.{getenv,putenv} were already being tested).

11 files changed, 125 insertions, 22 deletions

diff --git a/Changes b/Changes
index 5c62522e0f..9b40eaf9ec 100644
--- a/Changes
+++ b/Changes
@@ -424,8 +424,8 @@ Release branch for 4.06:
 
 ### Runtime system:
 
-* MPR#3771, GPR#153, GPR#1200, GPR#1357, GPR#1362, GPR#1363, GPR#1398: Unicode
-  support for the Windows runtime.
+* MPR#3771, GPR#153, GPR#1200, GPR#1357, GPR#1362, GPR#1363, GPR#1369, GPR#1398:
+  Unicode support for the Windows runtime.
   (ygrek, Nicolas Ojeda Bar, review by Alain Frisch, David Allsopp, Damien
   Doligez)
 
diff --git a/otherlibs/win32unix/envir.c b/otherlibs/win32unix/envir.c
index 84bba7e591..3324d6d2bd 100644
--- a/otherlibs/win32unix/envir.c
+++ b/otherlibs/win32unix/envir.c
@@ -21,23 +21,14 @@
 #include <caml/osdeps.h>
 
 #include <Windows.h>
+#include <stdlib.h>
 
 CAMLprim value unix_environment(value unit)
 {
-  CAMLparam0();
-  CAMLlocal2(v, result);
-  wchar_t * envp, * p;
-  int size, i;
-
   /* Win32 doesn't have a notion of setuid bit, so accessing environ is safe. */
-  envp = GetEnvironmentStrings();
-  for (p = envp, size = 0; *p; p += wcslen(p) + 1) size++;
-  result = caml_alloc(size, 0);
-  for (p = envp, i = 0; *p; p += wcslen(p) + 1) {
-    v = caml_copy_string_of_utf16(p);
-    Store_field(result, i ++, v);
+  if (_wenviron != NULL) {
+    return caml_alloc_array((void *)caml_copy_string_of_utf16, (const char**)_wenviron);
+  } else {
+    return Atom(0);
   }
-  FreeEnvironmentStrings(envp);
-
-  CAMLreturn(result);
 }
diff --git a/testsuite/tests/lib-unix/win-env/Makefile b/testsuite/tests/lib-unix/win-env/Makefile
new file mode 100755
index 0000000000..9077597c26
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/Makefile
@@ -0,0 +1,18 @@
+BASEDIR=../../..
+LIBRARIES=unix
+ADD_COMPFLAGS= \
+	-I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix \
+	-strict-sequence -safe-string -w A -warn-error A
+LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+C_FILES=stubs
+
+.PHONY: test
+test:
+	@if echo 'let () = exit (if Sys.win32 then 0 else 1)' | $(OCAML) -stdin; then \
+	  $(MAKE) check; \
+	else \
+	  $(MAKE) SKIP=true C_FILES= run-all; \
+	fi
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-unix/win-env/stubs.c b/testsuite/tests/lib-unix/win-env/stubs.c
new file mode 100644
index 0000000000..607103a976
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/stubs.c
@@ -0,0 +1,20 @@
+#define CAML_INTERNALS
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+
+#include <windows.h>
+
+CAMLprim value caml_SetEnvironmentVariable(value s1, value s2)
+{
+  WCHAR *w1, *w2;
+  w1 = caml_stat_strdup_to_utf16(String_val(s1));
+  w2 = caml_stat_strdup_to_utf16(String_val(s2));
+  SetEnvironmentVariableW(w1, w2);
+  caml_stat_free(w1);
+  caml_stat_free(w2);
+  return Val_unit;
+}
diff --git a/testsuite/tests/lib-unix/win-env/test_env.ml b/testsuite/tests/lib-unix/win-env/test_env.ml
new file mode 100755
index 0000000000..a13da93244
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env.ml
@@ -0,0 +1,30 @@
+external set_environment_variable: string -> string -> unit = "caml_SetEnvironmentVariable"
+
+let find_env s =
+  let env = Unix.environment () in
+  let rec loop i =
+    if i >= Array.length env then
+      None
+    else begin
+      let e = env.(i) in
+      let pos = String.index e '=' in
+      if String.sub e 0 pos = s then
+        Some (String.sub e (pos+1) (String.length e - pos - 1))
+      else
+        loop (i+1)
+    end
+  in
+  loop 0
+
+let print title = function
+  | None ->
+      Printf.printf "%s -> None\n%!" title
+  | Some s ->
+      Printf.printf "%s -> Some %S\n%!" title s
+
+let foo = "FOO"
+
+let () =
+  set_environment_variable foo "BAR";
+  print "Sys.getenv FOO" (Sys.getenv_opt foo);
+  print "Unix.environment FOO" (find_env foo)
diff --git a/testsuite/tests/lib-unix/win-env/test_env.reference b/testsuite/tests/lib-unix/win-env/test_env.reference
new file mode 100644
index 0000000000..63bdda30f7
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env.reference
@@ -0,0 +1,2 @@
+Sys.getenv FOO -> None
+Unix.environment FOO -> None
diff --git a/testsuite/tests/lib-unix/win-env/test_env2.ml b/testsuite/tests/lib-unix/win-env/test_env2.ml
new file mode 100755
index 0000000000..f2616ef991
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env2.ml
@@ -0,0 +1,17 @@
+(* This test is disabled (see test_env2.precheck) as it fails due to MPR#4499:
+   the Windows POSIX environment does not get updated when using the native
+   Windows API SetEnvironmentVariable. *)
+
+external set_environment_variable: string -> string -> unit = "caml_SetEnvironmentVariable"
+
+let print title = function
+  | None ->
+      Printf.printf "%s -> None\n%!" title
+  | Some s ->
+      Printf.printf "%s -> Some %S\n%!" title s
+
+let foo = "FOO"
+
+let () =
+  set_environment_variable foo "BAR";
+  print "Sys.getenv FOO" (Sys.getenv_opt foo)
diff --git a/testsuite/tests/lib-unix/win-env/test_env2.precheck b/testsuite/tests/lib-unix/win-env/test_env2.precheck
new file mode 100755
index 0000000000..8a1936f9b8
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env2.precheck
@@ -0,0 +1,4 @@
+# test_env2.ml disabled because it fails due to the fact that
+# Windows POSIX environment is not updated when using the native
+# API SetEnvironmentVariable (see MPR#4499)
+exit 1
diff --git a/testsuite/tests/lib-unix/win-env/test_env2.reference b/testsuite/tests/lib-unix/win-env/test_env2.reference
new file mode 100755
index 0000000000..19e10cb9b4
--- /dev/null
+++ b/testsuite/tests/lib-unix/win-env/test_env2.reference
@@ -0,0 +1 @@
+Sys.getenv FOO -> Some "BAR"
diff --git a/testsuite/tests/win-unicode/mltest.ml b/testsuite/tests/win-unicode/mltest.ml
index 709d79e282..bb6e284430 100644
--- a/testsuite/tests/win-unicode/mltest.ml
+++ b/testsuite/tests/win-unicode/mltest.ml
@@ -105,6 +105,25 @@ let wrap2 s f quote_in1 quote_in2 x y quote_out =
 let getenv s =
   wrap "Sys.getenv" Sys.getenv quote s quote
 
+let getenvironmentenv s =
+  let get s =
+    let env = Unix.environment () in
+    let rec loop i =
+      if i >= Array.length env then
+        ""
+      else begin
+        let e = env.(i) in
+        let pos = String.index e '=' in
+        if String.sub e 0 pos = s then
+          String.sub e (pos+1) (String.length e - pos - 1)
+        else
+          loop (i+1)
+      end
+    in
+    loop 0
+  in
+  wrap "Unix.environment" get quote s quote
+
 let putenv s x =
   wrap2 "Unix.putenv" Unix.putenv quote quote s x ok
 
@@ -191,10 +210,6 @@ let open_in s =
 let open_out s =
   wrap "open_out" open_out quote s ok
 
-let environment filter =
-  let f () = List.filter filter (Array.to_list (Unix.environment ())) in
-  wrap "Unix.environment" f unit () (list quote)
-
 let open_process_in cmdline =
   let f cmdline =
     let ic as proc = Unix.open_process_in cmdline in
@@ -260,7 +275,8 @@ let test_open_in () =
 let test_getenv () =
   let doit key s =
     putenv key s;
-    expect_string (getenv key) s
+    expect_string (getenv key) s;
+    expect_string (getenvironmentenv key) s
   in
   List.iter2 doit foreign_names foreign_names2
 
diff --git a/testsuite/tests/win-unicode/mltest.reference b/testsuite/tests/win-unicode/mltest.reference
index 30721ac341..4669a2ebd5 100644
--- a/testsuite/tests/win-unicode/mltest.reference
+++ b/testsuite/tests/win-unicode/mltest.reference
@@ -321,12 +321,16 @@ Sys.file_exists "你好" ... false
 
 Unix.putenv "été" "верблюды" ... OK
 Sys.getenv "été" ... "верблюды"
+Unix.environment "été" ... "верблюды"
 Unix.putenv "simple" "骆驼" ... OK
 Sys.getenv "simple" ... "骆驼"
+Unix.environment "simple" ... "骆驼"
 Unix.putenv "sœur" "קעמל" ... OK
 Sys.getenv "sœur" ... "קעמל"
+Unix.environment "sœur" ... "קעמל"
 Unix.putenv "你好" "اونٹ" ... OK
 Sys.getenv "你好" ... "اونٹ"
+Unix.environment "你好" ... "اونٹ"
 
 #16. Testing test_open_process_in
 ============================
@@ -339,4 +343,4 @@ Unix.open_process_in ... ... "верблюды" "骆驼" "קעמל" "اونٹ" "
 Unix.open_process_full ... "OCAML_UTF8_VAR0=верблюды" "OCAML_UTF8_VAR1=骆驼" "OCAML_UTF8_VAR2=קעמל" "OCAML_UTF8_VAR3=اونٹ" ... "OCAML_UTF8_VAR0=верблюды" "OCAML_UTF8_VAR1=骆驼" "OCAML_UTF8_VAR2=קעמל" "OCAML_UTF8_VAR3=اونٹ"
 
 
-*** ALL TESTS DONE (203/203 OK) ***
+*** ALL TESTS DONE (207/207 OK) ***