PR#6: fix handling of wchar_t and assignments from wide string literals.

- cparser/Machine indicates whether wchar_t is signed or not
  (it is signed int in Linux and BSD, but unsigned short in Win32)
- The type of a wide string literal is "wchar_t *" if the typedef "wchar_t"
  exists in the environment (e.g. after #include <stddef.h>).  Only if
  wchar_t is not defined do we use the default from Machine.
- Permit initialization of any integer array from a wide string literal,
  not just an array of wchar_t.

5 files changed, 31 insertions, 9 deletions

diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 9ad0b13d..7d1c2e4b 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -692,18 +692,30 @@ let find_matching_signed_ikind sz =
   else if sz = !config.sizeof_longlong then ILongLong
   else assert false
 
-let wchar_ikind = find_matching_unsigned_ikind !config.sizeof_wchar
+let wchar_ikind =
+  if !config.wchar_signed
+  then find_matching_signed_ikind !config.sizeof_wchar
+  else find_matching_unsigned_ikind !config.sizeof_wchar
 let size_t_ikind = find_matching_unsigned_ikind !config.sizeof_size_t
 let ptr_t_ikind = find_matching_unsigned_ikind !config.sizeof_ptr
 let ptrdiff_t_ikind = find_matching_signed_ikind !config.sizeof_ptrdiff_t
 
+(** The wchar_t type.  Try to get it from a typedef in the environment,
+  otherwise use the integer type described in !config. *)
+
+let wchar_type env =
+  try
+    let (id, def) = Env.lookup_typedef env "wchar_t" in TNamed(id, [])
+  with Env.Error _ ->
+    TInt(wchar_ikind, [])
+
 (** The type of a constant *)
 
-let type_of_constant = function
+let type_of_constant env = function
   | CInt(_, ik, _) -> TInt(ik, [])
   | CFloat(_, fk) -> TFloat(fk, [])
   | CStr _ -> TPtr(TInt(IChar, []), [])
-  | CWStr _ -> TPtr(TInt(wchar_ikind, []), [])
+  | CWStr _ -> TPtr(wchar_type env, [])
   | CEnum(_, _) -> TInt(IInt, [])
 
 (* Check that a C expression is a lvalue *)
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index 0de0c827..309981be 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -153,7 +153,7 @@ val ptrdiff_t_ikind : ikind
 
 (* Helpers for type-checking *)
 
-val type_of_constant : constant -> typ
+val type_of_constant : Env.t -> constant -> typ
   (* Return the type of the given constant. *)
 val type_of_member : Env.t -> field -> typ
   (* Return the type of accessing the given field [fld].
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index dd42ae24..f7168eba 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -1087,7 +1087,7 @@ and elab_item zi item il =
       | CStr _, _ ->
           error loc "initialization of an array of non-char elements with a string literal";
           elab_list zi il false
-      | CWStr s, TInt(ik, _) when ik = wchar_ikind ->
+      | CWStr s, TInt(ik, _) ->
           if not (I.index_below (Int64.of_int(List.length s - 1)) sz) then
             warning loc "initializer string for array of wide chars %s is too long"
                         (I.name zi);
@@ -1198,7 +1198,7 @@ let elab_expr loc env a =
 
   | CONSTANT cst ->
       let cst' = elab_constant loc cst in
-      { edesc = EConst cst'; etyp = type_of_constant cst' }
+      { edesc = EConst cst'; etyp = type_of_constant env cst' }
 
 (* 6.5.2 Postfix expressions *)
 
diff --git a/cparser/Machine.ml b/cparser/Machine.ml
index d8c55756..6a7f5054 100644
--- a/cparser/Machine.ml
+++ b/cparser/Machine.ml
@@ -29,6 +29,7 @@ type t = {
   sizeof_void: int option;
   sizeof_fun: int option;
   sizeof_wchar: int;
+  wchar_signed: bool;
   sizeof_size_t: int;
   sizeof_ptrdiff_t: int;
   alignof_ptr: int;
@@ -60,6 +61,7 @@ let ilp32ll64 = {
   sizeof_void = None;
   sizeof_fun = None;
   sizeof_wchar = 4;
+  wchar_signed = true;
   sizeof_size_t = 4;
   sizeof_ptrdiff_t = 4;
   alignof_ptr = 4;
@@ -91,6 +93,7 @@ let i32lpll64 = {
   sizeof_void = None;
   sizeof_fun = None;
   sizeof_wchar = 4;
+  wchar_signed = true;
   sizeof_size_t = 8;
   sizeof_ptrdiff_t = 8;
   alignof_ptr = 8;
@@ -122,6 +125,7 @@ let il32pll64 = {
   sizeof_void = None;
   sizeof_fun = None;
   sizeof_wchar = 4;
+  wchar_signed = true;
   sizeof_size_t = 8;
   sizeof_ptrdiff_t = 8;
   alignof_ptr = 8;
@@ -148,8 +152,12 @@ let x86_32 =
                    sizeof_longdouble = 12; alignof_longdouble = 4 }
 let x86_64 =
   { i32lpll64 with name = "x86_64"; char_signed = true }
+let win32 =
+  { ilp32ll64 with name = "win32"; char_signed = true;
+                   sizeof_wchar = 2; wchar_signed = false }
 let win64 =
-  { il32pll64 with name = "x86_64"; char_signed = true }
+  { il32pll64 with name = "win64"; char_signed = true;
+                   sizeof_wchar = 2; wchar_signed = false }
 let ppc_32_bigendian =
   { ilp32ll64 with name = "powerpc";
                    bigendian = true;
@@ -169,6 +177,6 @@ let gcc_extensions c =
 
 let config =
   ref (match Sys.word_size with
-           | 32 -> ilp32ll64
-           | 64 -> if Sys.os_type = "Win32" then il32pll64 else i32lpll64
+           | 32 -> if Sys.os_type = "Win32" then win32 else ilp32ll64
+           | 64 -> if Sys.os_type = "Win32" then win64 else i32lpll64
            | _  -> assert false)
diff --git a/cparser/Machine.mli b/cparser/Machine.mli
index 0381bfce..b544711f 100644
--- a/cparser/Machine.mli
+++ b/cparser/Machine.mli
@@ -29,6 +29,7 @@ type t = {
   sizeof_void: int option;
   sizeof_fun: int option;
   sizeof_wchar: int;
+  wchar_signed: bool;
   sizeof_size_t: int;
   sizeof_ptrdiff_t: int;
   alignof_ptr: int;
@@ -51,6 +52,7 @@ val i32lpll64 : t
 val il32pll64 : t
 val x86_32 : t
 val x86_64 : t
+val win32 : t
 val win64 : t
 val ppc_32_bigendian : t
 val arm_littleendian : t