+ support for array of widechar typed constants (based on patch by

    Blaise Thorn, mantis #16004)

git-svn-id: trunk@15096 -

.gitattributes

@@ -10336,6 +10336,7 @@ tests/webtbs/tw15843.pp svneol=native#text/plain
 tests/webtbs/tw15909.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain
 tests/webtbs/tw15930.pp svneol=native#text/plain
+tests/webtbs/tw16004.pp svneol=native#text/plain
 tests/webtbs/tw16040.pp svneol=native#text/plain
 tests/webtbs/tw16083.pp svneol=native#text/plain
 tests/webtbs/tw1617.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -422,6 +422,7 @@ interface
           constructor Create_32bit(_value : longint);
           constructor Create_16bit(_value : word);
           constructor Create_8bit(_value : byte);
+          constructor Create_char(size: integer; _value: dword);
           constructor Create_sleb128bit(_value : int64);
           constructor Create_uleb128bit(_value : qword);
           constructor Create_aint(_value : aint);
@@ -1137,6 +1138,27 @@ implementation
       end;
 
 
+    constructor tai_const.Create_char(size: integer; _value: dword);
+      begin
+         inherited Create;
+         typ:=ait_const;
+         case size of
+            1:
+              begin
+                consttype:=aitconst_8bit;
+                value:=byte(_value)
+              end;
+             2:
+               begin
+                 consttype:=aitconst_16bit;
+                 value:=word(_value)
+               end
+             else
+               InternalError(2010030701)
+         end
+      end;
+
+
     constructor tai_const.Create_sleb128bit(_value : int64);
       begin
          inherited Create;

compiler/defutil.pas

@@ -80,6 +80,9 @@ interface
     {# Returns true if definition is a widechar }
     function is_widechar(def : tdef) : boolean;
 
+    {# Returns true if definition is either an AnsiChar or a WideChar }
+    function is_anychar(def : tdef) : boolean;
+
     {# Returns true if definition is a void}
     function is_void(def : tdef) : boolean;
 
@@ -476,6 +479,14 @@ implementation
       end;
 
 
+    { true if p is a char or wchar }
+    function is_anychar(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+                 (torddef(def).ordtype in [uchar,uwidechar])
+      end;
+
+
     { true if p is signed (integer) }
     function is_signed(def : tdef) : boolean;
       begin

compiler/ptconst.pas

@@ -824,8 +824,10 @@ implementation
           n : tnode;
           i : longint;
           len : aint;
-          ch  : char;
-          ca  : pchar;
+          ch  : array[0..1] of char;
+          ca  : pbyte;
+          int_const: tai_const;
+          char_size: integer;
         begin
           { dynamic array nil }
           if is_dynamic_array(def) then
@@ -862,22 +864,46 @@ implementation
               consume(_RKLAMMER);
             end
           { if array of char then we allow also a string }
-          else if is_char(def.elementdef) then
+          else if is_anychar(def.elementdef) then
             begin
+               char_size:=def.elementdef.size;
                n:=comp_expr(true);
                if n.nodetype=stringconstn then
                  begin
                    len:=tstringconstnode(n).len;
+                    case char_size of
+                      1:
+                        ca:=pointer(tstringconstnode(n).value_str);
+                      2:
+                        begin
+                          inserttypeconv(n,cwidestringtype);
+                          if n.nodetype<>stringconstn then
+                            internalerror(2010033003);
+                          ca:=pointer(pcompilerwidestring(tstringconstnode(n).value_str)^.data)
+                        end;
+                      else
+                        internalerror(2010033005);
+                    end;
                    { For tp7 the maximum lentgh can be 255 }
                    if (m_tp7 in current_settings.modeswitches) and
                       (len>255) then
                     len:=255;
-                   ca:=tstringconstnode(n).value_str;
                  end
-               else
-                 if is_constcharnode(n) then
+               else if is_constcharnode(n) then
                   begin
-                    ch:=chr(tordconstnode(n).value.uvalue and $ff);
+                    case char_size of
+                      1:
+                        ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                      2:
+                        begin
+                          inserttypeconv(n,cwidechartype);
+                          if not is_constwidecharnode(n) then
+                            internalerror(2010033001);
+                          widechar(ch):=widechar(tordconstnode(n).value.uvalue and $ffff);
+                        end;
+                      else
+                        internalerror(2010033002);
+                    end;
                     ca:=@ch;
                     len:=1;
                   end
@@ -888,16 +914,24 @@ implementation
                  end;
                if len>(def.highrange-def.lowrange+1) then
                  Message(parser_e_string_larger_array);
-               for i:=def.lowrange to def.highrange do
+               for i:=0 to def.highrange-def.lowrange do
                  begin
-                    if i+1-def.lowrange<=len then
-                      begin
-                         hr.list.concat(Tai_const.Create_8bit(byte(ca^)));
-                         inc(ca);
-                      end
-                    else
-                      {Fill the remaining positions with #0.}
-                      hr.list.concat(Tai_const.Create_8bit(0));
+                   if i<len then
+                     begin
+                       case char_size of
+                         1:
+                          int_const:=Tai_const.Create_char(char_size,pbyte(ca)^);
+                         2:
+                          int_const:=Tai_const.Create_char(char_size,pword(ca)^);
+                         else
+                           internalerror(2010033004);
+                       end;
+                       inc(ca, char_size);
+                     end
+                   else
+                     {Fill the remaining positions with #0.}
+                     int_const:=Tai_const.Create_char(char_size,0);
+                   hr.list.concat(int_const)
                  end;
                n.free;
             end

tests/webtbs/tw16004.pp

@@ -0,0 +1,43 @@
+{$apptype console}
+{$mode Delphi}
+{$assertions on}
+{$codepage cp1251}
+
+function verify(const p; const size: integer; const z: array of byte): boolean;
+begin
+	assert( size = length(z)*sizeof(z[0]) );
+	result := CompareByte(p, z[0], size) = 0;
+	writeln(result)
+end;
+
+	procedure foo;
+	var a: array[0..5] of char = 'willow';
+	const b: array[0..2] of WideChar = 'èâà';
+	begin
+		assert( verify(a, sizeof(a), [ord('w'), ord('i'), ord('l'), ord('l'), ord('o'), ord('w')]) );
+{$ifdef endian_big}
+		assert( verify(b, sizeof(b), [$04,$38,$04,$32,$04,$30]) )
+{$else}
+		assert( verify(b, sizeof(b), [$38,$04,$32,$04,$30,$04]) )
+{$endif}
+	end;
+
+const c: array[0..10] of char = 'rosenberg';
+var d: array[0..10] of WideChar = 'ðîçåíáåðã';
+	z: array[0..1] of WideChar = 'û';
+	x: array[0..0] of char = 'x';
+begin
+	assert( verify(c, sizeof(c), [114, 111, 115, 101, 110, 98, 101, 114, 103, 0, 0]) );
+{$ifdef endian_big}
+	assert( verify(d, sizeof(d), [$04,$40,$04,$3E,$04,$37,$04,$35,$04,$3D,$04,$31,$04,$35,$04,$40,$04,$33,0,0,0,0]) );
+{$else}
+	assert( verify(d, sizeof(d), [$40,$04,$3E,$04,$37,$04,$35,$04,$3D,$04,$31,$04,$35,$04,$40,$04,$33,$04,0,0,0,0]) );
+{$endif}
+	foo;
+{$ifdef endian_big}
+	assert( verify(z, sizeof(z), [$04,$4B,0,0]) );
+{$else}
+	assert( verify(z, sizeof(z), [$4B,$04,0,0]) );
+{$endif}
+	assert( verify(x, sizeof(x), [120]) )
+end.