* fixed initialising an array of ansichar typed constant using a string

    constant: directly encode the character values in the constant, rather
    than letting unicodestr_to_chararray handle the conversion (which
    implies a codepage conversion)

git-svn-id: trunk@33158 -

compiler/jvm/njvmtcon.pas

@@ -42,6 +42,7 @@ interface
       tjvmtypedconstbuilder = class(tnodetreetypedconstbuilder)
        private
         procedure tc_flush_arr_strconst(def: tdef);
+        procedure tc_emit_arr_strconst_ele(val: int64; def: torddef);
        protected
         arrstringdata: tarrstringdata;
         parsingordarray: boolean;
@@ -55,8 +56,9 @@ implementation
 
     uses
       globals,widestr,verbose,constexp,
+      tokens,scanner,pexpr,
       defutil,
-      nbas,ncal,ncon,njvmcon;
+      nbas,ncal,ncon,ncnv,njvmcon;
 
 
     procedure init_arrstringdata(out data: tarrstringdata);
@@ -88,7 +90,9 @@ implementation
             tcompilerwidechar(ord(arrstringdata.arrstring[length(arrstringdata.arrstring)]) shl 8));
 
 
-        if is_signed(def) then
+        if is_char(def) then
+          procvariant:='ansichar'
+        else if is_signed(def) then
           case def.size of
             1: procvariant:='shortint';
             2: procvariant:='smallint';
@@ -121,14 +125,54 @@ implementation
       end;
 
 
+    procedure tjvmtypedconstbuilder.tc_emit_arr_strconst_ele(val: int64; def: torddef);
+      var
+        elesize: longint;
+      begin
+        elesize:=def.size;
+        inc(arrstringdata.arrdatalen);
+        case elesize of
+          1:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char(val);
+          2:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char(val shr 8)+char(val and $ff);
+          4:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char((val shr 24))+
+              char((val shr 16) and $ff)+
+              char((val shr 8) and $ff)+
+              char(val and $ff);
+          8:
+            arrstringdata.arrstring:=arrstringdata.arrstring+char((val shr 56))+
+              char((val shr 48) and $ff)+
+              char((val shr 40) and $ff)+
+              char((val shr 32) and $ff)+
+              char((val shr 24) and $ff)+
+              char((val shr 16) and $ff)+
+              char((val shr 8) and $ff)+
+              char(val and $ff);
+        end;
+        { we can't use the full 64kb, because inside the Java class file the
+          string constant is actually encoded using UTF-8 and it's this UTF-8
+          encoding that has to fit inside 64kb (and utf-8 encoding of random
+          data can easily blow up its size by about a third) }
+        if length(arrstringdata.arrstring)>40000 then
+          tc_flush_arr_strconst(def);
+      end;
+
+
     procedure tjvmtypedconstbuilder.parse_arraydef(def: tarraydef);
       var
+        n: tnode;
+        i, len: longint;
+        ca: pbyte;
+        ch: array[0..1] of char;
         old_arrstringdata: tarrstringdata;
         old_parsingordarray: boolean;
       begin
         if is_dynamic_array(def) or
-           not is_integer(def.elementdef) or
-           not(ts_compact_int_array_init in current_settings.targetswitches) then
+           (not is_char(def.elementdef) and
+            (not is_integer(def.elementdef) or
+             not(ts_compact_int_array_init in current_settings.targetswitches))) then
           begin
             inherited;
             exit;
@@ -138,7 +182,66 @@ implementation
         arrstringdata.arraybase:=basenode.getcopy;
         old_parsingordarray:=parsingordarray;
         parsingordarray:=true;
-        inherited;
+        if (token=_LKLAMMER) or
+           not is_char(def.elementdef) then
+          inherited
+        else
+          begin
+            { array of ansichar -> can be constant char/string; can't use plain
+              assignment in this case, because it will result in a codepage
+              conversion }
+            n:=comp_expr([ef_accept_equal]);
+            if n.nodetype=stringconstn then
+              begin
+                len:=tstringconstnode(n).len;
+                if (tstringconstnode(n).cst_type in [cst_unicodestring,cst_widestring]) then
+                  inserttypeconv(n,getansistringdef);
+                  if n.nodetype<>stringconstn then
+                    internalerror(2010033003);
+                  ca:=pbyte(tstringconstnode(n).value_str);
+                { For tp7 the maximum lentgh can be 255 }
+                if (m_tp7 in current_settings.modeswitches) and
+                   (len>255) then
+                 len:=255;
+              end
+            else if is_constcharnode(n) then
+               begin
+                 ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                 ca:=@ch;
+                 len:=1;
+               end
+            else if is_constwidecharnode(n) and (current_settings.sourcecodepage<>CP_UTF8) then
+               begin
+                 inserttypeconv(n,cansichartype);
+                 if not is_constcharnode(n) then
+                   internalerror(2010033001);
+                 ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                 ca:=@ch;
+                 len:=1;
+               end
+            else
+              begin
+                Message(parser_e_illegal_expression);
+                len:=0;
+                { avoid crash later on }
+                ch[0]:=#0;
+                ca:=@ch;
+              end;
+            if len>(def.highrange-def.lowrange+1) then
+              Message(parser_e_string_larger_array);
+            for i:=0 to def.highrange-def.lowrange do
+              begin
+                if i<len then
+                  begin
+                    tc_emit_arr_strconst_ele(pbyte(ca)^,torddef(cansichartype));
+                    inc(ca);
+                  end
+                else
+                  {Fill the remaining positions with #0.}
+                  tc_emit_arr_strconst_ele(0,torddef(cansichartype));
+              end;
+            n.free;
+          end;
         if length(arrstringdata.arrstring)<>0 then
           tc_flush_arr_strconst(def.elementdef);
         arrstringdata.arraybase.free;
@@ -158,8 +261,6 @@ implementation
 
 
     procedure tjvmtypedconstbuilder.tc_emit_orddef(def: torddef; var node: tnode);
-      var
-        elesize: longint;
       begin
         if not parsingordarray then
           begin
@@ -168,34 +269,7 @@ implementation
           end;
         if node.nodetype<>ordconstn then
           internalerror(2011111101);
-        elesize:=def.size;
-        inc(arrstringdata.arrdatalen);
-        case elesize of
-          1:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue);
-          2:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue shr 8)+char(tordconstnode(node).value.svalue and $ff);
-          4:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 24))+
-              char((tordconstnode(node).value.svalue shr 16) and $ff)+
-              char((tordconstnode(node).value.svalue shr 8) and $ff)+
-              char(tordconstnode(node).value.svalue and $ff);
-          8:
-            arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 56))+
-              char((tordconstnode(node).value.svalue shr 48) and $ff)+
-              char((tordconstnode(node).value.svalue shr 40) and $ff)+
-              char((tordconstnode(node).value.svalue shr 32) and $ff)+
-              char((tordconstnode(node).value.svalue shr 24) and $ff)+
-              char((tordconstnode(node).value.svalue shr 16) and $ff)+
-              char((tordconstnode(node).value.svalue shr 8) and $ff)+
-              char(tordconstnode(node).value.svalue and $ff);
-        end;
-        { we can't use the full 64kb, because inside the Java class file the
-          string constant is actually encoded using UTF-8 and it's this UTF-8
-          encoding that has to fit inside 64kb (and utf-8 encoding of random
-          data can easily blow up its size by about a third) }
-        if length(arrstringdata.arrstring)>40000 then
-          tc_flush_arr_strconst(def);
+        tc_emit_arr_strconst_ele(tordconstnode(node).value.svalue,def);
         basenode.free;
         basenode:=nil;
         node.free;

rtl/java/jtcon.inc

@@ -73,6 +73,7 @@ procedure fpc_tcon_int64_array_from_string(const s: unicodestring; var arr: arra
 { specifying compilerprocs using an external name doesn't work yet }
 
 procedure fpc_tcon_shortint_array_from_string_intern_as_byte(const s: unicodestring; var arr: array of byte; startindex, len: longint); external name 'fpc_tcon_shortint_array_from_string';
+procedure fpc_tcon_ansichar_array_from_string(const s: unicodestring; var arr: array of ansichar; startindex, len: longint); external name 'fpc_tcon_shortint_array_from_string';
 procedure fpc_tcon_smallint_array_from_string_intern_as_word(const s: unicodestring; var arr: array of word; startindex, len: longint); external name 'fpc_tcon_smallint_array_from_string';
 procedure fpc_tcon_longint_array_from_string_intern_as_cardinal(const s: unicodestring; var arr: array of cardinal; startindex, len: longint); external name 'fpc_tcon_longint_array_from_string';
 procedure fpc_tcon_int64_array_from_string_intern_as_int64(const s: unicodestring; var arr: array of qword; startindex, len: longint); external name 'fpc_tcon_int64_array_from_string';

rtl/java/jtconh.inc

@@ -17,6 +17,7 @@
 
 procedure fpc_tcon_shortint_array_from_string(const s: unicodestring; var arr: array of shortint; startindex, len: longint); compilerproc;
 procedure fpc_tcon_byte_array_from_string(const s: unicodestring; var arr: array of byte; startindex, len: longint); compilerproc;
+procedure fpc_tcon_ansichar_array_from_string(const s: unicodestring; var arr: array of ansichar; startindex, len: longint); compilerproc;
 
 procedure fpc_tcon_smallint_array_from_string(const s: unicodestring; var arr: array of smallint; startindex, len: longint); compilerproc;
 procedure fpc_tcon_word_array_from_string(const s: unicodestring; var arr: array of word; startindex, len: longint); compilerproc;