Merge pull request #1357 from nojb/make_ocamltest_unicode_aware

Fix ocamltest / Windows / Unicode issues

6 files changed, 60 insertions, 44 deletions

diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml
index 4c23e62fd3..a392e58f39 100644
--- a/ocamltest/builtin_actions.ml
+++ b/ocamltest/builtin_actions.ml
@@ -702,6 +702,11 @@ let compare_programs backend comparison_tool log env =
     Printf.fprintf log
       "flambda temporarily disables comparison of native programs";
     Pass env
+  end else if backend = Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
+  then begin
+    Printf.fprintf log
+      "comparison of native programs temporarily disabled under Windows";
+    Pass env
   end else begin
     let comparison_tool =
       if backend=Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
diff --git a/ocamltest/run.h b/ocamltest/run.h
index a3daa519b2..537ebea875 100644
--- a/ocamltest/run.h
+++ b/ocamltest/run.h
@@ -20,18 +20,19 @@
 #define __RUN_H__
 
 #include <stdarg.h>
+#include <caml/misc.h>
 
-typedef char **array;
+typedef charnat **array;
 
 typedef void Logger(void *, const char *, va_list ap);
 
 typedef struct {
-  const char *program;
+  charnat *program;
   array argv;
   /* array envp; */
-  const char *stdin_filename;
-  const char *stdout_filename;
-  const char *stderr_filename;
+  charnat *stdin_filename;
+  charnat *stdout_filename;
+  charnat *stderr_filename;
   int append;
   int timeout;
   Logger *logger;
diff --git a/ocamltest/run_common.h b/ocamltest/run_common.h
index 8f05fa2f89..04603acf7d 100644
--- a/ocamltest/run_common.h
+++ b/ocamltest/run_common.h
@@ -20,9 +20,9 @@
 
 /* is_defined(str) returns 1 iff str points to a non-empty string */
 /* Otherwise returns 0 */
-static int is_defined(const char *str)
+static int is_defined(const charnat *str)
 {
-  return (str != NULL) && (*str != '\0');
+  return (str != NULL) && (*str != 0);
 }
 
 static void defaultLogger(void *where, const char *format, va_list ap)
diff --git a/ocamltest/run_stubs.c b/ocamltest/run_stubs.c
index a3cd7adabd..f70d5ddaa4 100644
--- a/ocamltest/run_stubs.c
+++ b/ocamltest/run_stubs.c
@@ -28,6 +28,7 @@
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "caml/io.h"
+#include "caml/osdeps.h"
 
 /* cstringvect: inspired by similar function in otherlibs/unix/cstringv.c */
 static array cstringvect(value arg)
@@ -36,16 +37,16 @@ static array cstringvect(value arg)
   mlsize_t size, i;
 
   size = Wosize_val(arg);
-  res = (array) caml_stat_alloc((size + 1) * sizeof(char *));
+  res = (array) caml_stat_alloc((size + 1) * sizeof(charnat *));
   for (i = 0; i < size; i++)
-    res[i] = caml_stat_strdup(String_val(Field(arg, i)));
+    res[i] = caml_stat_strdup_to_utf16(String_val(Field(arg, i)));
   res[size] = NULL;
   return res;
 }
 
 static void free_cstringvect(array v)
 {
-  char **p;
+  charnat **p;
   for (p = v; *p != NULL; p++)
     caml_stat_free(*p);
   caml_stat_free(v);
@@ -78,17 +79,21 @@ CAMLprim value caml_run_command(value caml_settings)
   command_settings settings;
 
   CAMLparam1(caml_settings);
-  settings.program = String_val(Field(caml_settings, 0));
+  settings.program = caml_stat_strdup_to_utf16(String_val(Field(caml_settings, 0)));
   settings.argv = cstringvect(Field(caml_settings, 1));
   /* settings.envp = cstringvect(Field(caml_settings, 2)); */
-  settings.stdin_filename = String_val(Field(caml_settings, 2));
-  settings.stdout_filename = String_val(Field(caml_settings, 4));
-  settings.stderr_filename = String_val(Field(caml_settings, 4));
+  settings.stdin_filename = caml_stat_strdup_to_utf16(String_val(Field(caml_settings, 2)));
+  settings.stdout_filename = caml_stat_strdup_to_utf16(String_val(Field(caml_settings, 4)));
+  settings.stderr_filename = caml_stat_strdup_to_utf16(String_val(Field(caml_settings, 4)));
   settings.append = Bool_val(Field(caml_settings, 5));
   settings.timeout = Int_val(Field(caml_settings, 6));
   settings.logger = logToChannel;
   settings.loggerData = Channel(Field(caml_settings, 7));
   res = run_command(&settings);
+  caml_stat_free(settings.program);
   free_cstringvect(settings.argv);
+  caml_stat_free(settings.stdin_filename);
+  caml_stat_free(settings.stdout_filename);
+  caml_stat_free(settings.stderr_filename);
   CAMLreturn(Val_int(res));
 }
diff --git a/ocamltest/run_win32.c b/ocamltest/run_win32.c
index 5240b81b7c..b60e5daccd 100644
--- a/ocamltest/run_win32.c
+++ b/ocamltest/run_win32.c
@@ -26,33 +26,38 @@
 #include <stdarg.h>
 #include <sys/types.h>
 
+#include "caml/osdeps.h"
+
 #include "run.h"
 #include "run_common.h"
 
 static void report_error(
   const char *file, int line,
   const command_settings *settings,
-  const char *message, const char *argument)
+  const char *message, const WCHAR *argument)
 {
-  char error_message[1024];
+  WCHAR error_message[1024];
   DWORD error = GetLastError();
+  char *error_message_c;
   FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, NULL, error, 0,
-    (LPTSTR) &error_message, sizeof(error_message), NULL);
+                error_message, sizeof(error_message)/sizeof(WCHAR), NULL);
+  error_message_c = caml_stat_strdup_of_utf16(error_message);
   if ( is_defined(argument) )
     error_with_location(file, line,
-      settings, "%s %s: %s", message, argument, error_message);
+      settings, "%s %s: %s", message, argument, error_message_c);
   else
     error_with_location(file, line,
-      settings, "%s: %s", message, error_message);
+      settings, "%s: %s", message, error_message_c);
+  caml_stat_free(error_message_c);
 }
 
-static char *find_program(const char *program_name)
+static WCHAR *find_program(const WCHAR *program_name)
 {
   int max_path_length = 512;
   DWORD result;
-  LPCTSTR searchpath = NULL, extension = ".exe";
-  char **filepart = NULL;
-  char *fullpath = malloc(max_path_length);
+  LPCWSTR searchpath = NULL, extension = L".exe";
+  WCHAR **filepart = NULL;
+  WCHAR *fullpath = malloc(max_path_length*sizeof(WCHAR));
   if (fullpath == NULL) return NULL;
 
   result = SearchPath
@@ -67,10 +72,10 @@ static char *find_program(const char *program_name)
   if (result == 0)
   {
     /* It may be an absolute path, return a copy of it */
-    int l = strlen(program_name) + 1;
+    int l = wcslen(program_name) + 1;
     free(fullpath);
-    fullpath = malloc(l);
-    if (fullpath != NULL) strcpy(fullpath, program_name);
+    fullpath = malloc(l*sizeof(WCHAR));
+    if (fullpath != NULL) wcscpy(fullpath, program_name);
     return fullpath;
   }
   if (result <= max_path_length) return fullpath;
@@ -80,7 +85,7 @@ static char *find_program(const char *program_name)
 
   result++; /* Take '\0' into account */
 
-  fullpath = malloc(result);
+  fullpath = malloc(result*sizeof(WCHAR));
   if (fullpath == NULL) return NULL;
   SearchPath
   (
@@ -94,9 +99,9 @@ static char *find_program(const char *program_name)
   return fullpath;
 }
 
-static char *commandline_of_arguments(char **arguments)
+static WCHAR *commandline_of_arguments(WCHAR **arguments)
 {
-  char *commandline = NULL, **arguments_p, *commandline_p;
+  WCHAR *commandline = NULL, **arguments_p, *commandline_p;
   int args = 0; /* Number of arguments */
   int commandline_length = 0;
 
@@ -107,23 +112,23 @@ static char *commandline_of_arguments(char **arguments)
   for (arguments_p = arguments; *arguments_p != NULL; arguments_p++)
   {
     args++;
-    commandline_length += strlen(*arguments_p);
+    commandline_length += wcslen(*arguments_p);
   }
   commandline_length += args; /* args-1 ' ' between arguments + final '\0' */
 
   /* Allocate memory and accumulate arguments separated by spaces */
-  commandline = malloc(commandline_length);
+  commandline = malloc(commandline_length*sizeof(WCHAR));
   if (commandline == NULL) return NULL;
   commandline_p = commandline;
   for (arguments_p = arguments; *arguments_p!=NULL; arguments_p++)
   {
-    int l = strlen(*arguments_p);
-    memcpy(commandline_p, *arguments_p, l);
+    int l = wcslen(*arguments_p);
+    memcpy(commandline_p, *arguments_p, l*sizeof(WCHAR));
     commandline_p += l;
-    *commandline_p = ' ';
+    *commandline_p = L' ';
     commandline_p++;
   }
-  commandline[commandline_length-1] = '\0';
+  commandline[commandline_length-1] = 0;
   return commandline;
 }
 
@@ -133,7 +138,7 @@ static SECURITY_ATTRIBUTES security_attributes = {
   TRUE /* bInheritHandle */
 };
 
-static HANDLE create_input_handle(const char *filename)
+static HANDLE create_input_handle(const WCHAR *filename)
 {
   return CreateFile
   (
@@ -147,7 +152,7 @@ static HANDLE create_input_handle(const char *filename)
   );
 }
 
-static HANDLE create_output_handle(const char *filename, int append)
+static HANDLE create_output_handle(const WCHAR *filename, int append)
 {
   DWORD desired_access = append ? FILE_APPEND_DATA : GENERIC_WRITE;
   DWORD share_mode = FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE;
@@ -178,11 +183,11 @@ int run_command(const command_settings *settings)
   int stdin_redirected = 0, stdout_redirected = 0, stderr_redirected = 0;
   int combined = 0; /* 1 if stdout and stderr are redirected to the same file */
   int wait_again = 0;
-  char *program = NULL;
-  char *commandline = NULL;
+  WCHAR *program = NULL;
+  WCHAR *commandline = NULL;
 
   LPVOID environment = NULL;
-  LPCTSTR current_directory = NULL;
+  LPCWSTR current_directory = NULL;
   STARTUPINFO startup_info;
   PROCESS_INFORMATION process_info;
   DWORD wait_result, status;
@@ -225,7 +230,7 @@ int run_command(const command_settings *settings)
   {
     if (stdout_redirected)
     {
-      if (strcmp(settings->stdout_filename, settings->stderr_filename) == 0)
+      if (wcscmp(settings->stdout_filename, settings->stderr_filename) == 0)
       {
         startup_info.hStdError = startup_info.hStdOutput;
         stderr_redirected = 1;
@@ -252,7 +257,7 @@ int run_command(const command_settings *settings)
     NULL, /* SECURITY_ATTRIBUTES process_attributes */
     NULL, /* SECURITY_ATTRIBUTES thread_attributes */
     TRUE, /* BOOL inherit_handles */
-    0, /* DWORD creation_flags */
+    CREATE_UNICODE_ENVIRONMENT, /* DWORD creation_flags */
     NULL, /* LPVOID environment */
     NULL, /* LPCSTR current_directory */
     &startup_info,
@@ -290,7 +295,7 @@ cleanup:
   if (stderr_redirected && !combined) CloseHandle(startup_info.hStdError);
   if (wait_again)
   {
-    /* Wait agian but this time just 1sec to avoid being blocked */
+    /* Wait again but this time just 1sec to avoid being blocked */
     WaitForSingleObject(process_info.hProcess, 1000);
   }
   if (process_created) CloseHandle(process_info.hProcess);
diff --git a/testsuite/tests/letrec/generic_array.ml b/testsuite/tests/letrec/generic_array.ml
index 5afc4bca63..f71eb34634 100644
--- a/testsuite/tests/letrec/generic_array.ml
+++ b/testsuite/tests/letrec/generic_array.ml
@@ -1,3 +1,3 @@
-let rec x = let y = [| |] in ();;
+let rec x = let _y = [| |] in ();;
 
 let rec x = let y = [| |] in y :: x;;