* changed *string_to_*chararray helpers from functions into procedures

    because on win64 the location of a function result can depend on its
    size (so some chararrays had to be returned in registers and others
    by reference, which means it's impossible to have a generic function
    declaration which works in all cases) (mantis #8533)
  * pad constant string assignments to chararrays with #0 up to the
    length of the chararray for 2.0.x compatibility (fixes
    tests/test/tarray3)

git-svn-id: trunk@6915 -

compiler/ncnv.pas

@@ -778,6 +778,10 @@ implementation
 
     function ttypeconvnode.typecheck_string_to_chararray : tnode;
       var
+        newblock : tblocknode;
+        newstat  : tstatementnode;
+        restemp  : ttempcreatenode;
+        pchtemp  : pchar;
         arrsize  : aint;
         chartype : string[8];
       begin
@@ -795,7 +799,18 @@ implementation
                constant directly. This is handled in ncgcnv }
              if (arrsize>=tstringconstnode(left).len) and
                 is_char(tarraydef(resultdef).elementdef) then
-               exit;
+               begin
+                 { pad the constant string with #0 to the array len }
+                 { (2.0.x compatible)                               }
+                 if (arrsize>tstringconstnode(left).len) then
+                   begin
+                     pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
+                     left.free;
+                     left:=cstringconstnode.createpchar(pchtemp,arrsize);
+                     typecheckpass(left);
+                   end;
+                 exit;
+               end;
              { Convert to wide/short/ansistring and call default helper }
              if is_widechar(tarraydef(resultdef).elementdef) then
                inserttypeconv(left,cwidestringtype)
@@ -811,11 +826,16 @@ implementation
           chartype:='widechar'
         else
           chartype:='char';
-        result := ccallnode.createinternres(
-          'fpc_'+tstringdef(left.resultdef).stringtypname+
+        newblock:=internalstatements(newstat);
+        restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
+        addstatement(newstat,restemp);
+        addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
           '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
-          cordconstnode.create(arrsize,s32inttype,true),nil)),resultdef);
-        left := nil;
+          ctemprefnode.create(restemp),nil))));
+        addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
+        addstatement(newstat,ctemprefnode.create(restemp));
+        result:=newblock;
+        left:=nil;
       end;
 
 

compiler/options.pas

@@ -1956,6 +1956,8 @@ begin
   def_system_macro('FPC_HAS_VALGRINDBOOL');
   def_system_macro('FPC_HAS_STR_CURRENCY');
   def_system_macro('FPC_REAL2REAL_FIXED');
+  def_system_macro('FPC_STRTOCHARARRAYPROC');
+
 {$if defined(x86) or defined(arm)}
   def_system_macro('INTERNAL_BACKTRACE');
 {$endif}

rtl/inc/astrings.inc

@@ -409,6 +409,7 @@ begin
   Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
 end;
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
 
 { note: inside the compiler, the resulttype is modified to be the length }
 { of the actual chararray to which we convert (JM)                       }
@@ -430,7 +431,27 @@ begin
 {$endif}
 end;
 
+{$else ndef FPC_STRTOCHARARRAYPROC}
 
+procedure  fpc_ansistr_to_chararray(out res: array of char; const src: ansistring); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len);
+  { fpc_big_chararray is defined as array[0..0], see compproc.inc why }
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE'];  compilerproc;
 {

rtl/inc/compproc.inc

@@ -28,8 +28,10 @@ type
     internally. It's now set to 0..0 because when compiling with -gt,
     the entire array will be trashed, so it must not be defined larger
     than the minimal size (otherwise we can trash other memory) }
+{$ifndef FPC_STRTOCHARARRAYPROC}
   fpc_big_chararray = array[0..0] of char;
   fpc_big_widechararray = array[0..0] of widechar;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
   fpc_small_set = longint;
   fpc_normal_set = array[0..7] of longint;
 
@@ -57,7 +59,11 @@ function fpc_pchar_length(p:pchar):longint; compilerproc;
 function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
 
 function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 
 Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
 function  fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
@@ -176,7 +182,11 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerp
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
 Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_ansistr_to_chararray(out res: array of char; const src: ansistring)compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
@@ -210,13 +220,20 @@ Procedure fpc_WideStr_Concat_multi (Var DestS : Widestring;const sarr:array of W
 Function fpc_Char_To_WideStr(const c : WideChar): WideString; compilerproc;
 Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
 Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
+{$ifndef FPC_STRTOCHARARRAYPROC}
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
-Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
 Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
-Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
+{$else ndef FPC_STRTOCHARARRAYPROC}
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;

rtl/inc/generic.inc

@@ -760,6 +760,8 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { chararray we're converting to (JM)                                    }
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
@@ -779,6 +781,27 @@ begin
 {$endif}
 end;
 
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
+var
+  len: longint;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    move(src[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
 {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

rtl/inc/wstrings.inc

@@ -662,6 +662,8 @@ begin
   PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
 end;
 
+{$ifndef FPC_STRTOCHARARRAYPROC}
+
 { inside the compiler, the resulttype is modified to that of the actual }
 { chararray we're converting to (JM)                                    }
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
@@ -748,6 +750,90 @@ begin
 {$endif}
 end;
 
+{$else ndef FPC_STRTOCHARARRAYPROC}
+
+procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+  temp: ansistring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len);
+  fillchar(res[len],length(res)-len,0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
+var
+  len: SizeInt;
+begin
+  len := length(src);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  { make sure we don't try to access element 1 of the ansistring if it's nil }
+  if len > 0 then
+    move(src[1],res[0],len*SizeOf(WideChar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+
+procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
+var
+  len: SizeInt;
+  temp: widestring;
+begin
+  len := length(src);
+  { make sure we don't dereference src if it can be nil (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+
+{$r-}
+  move(temp[1],res[0],len*sizeof(widechar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
+var
+  len: longint;
+  temp : widestring;
+begin
+  len := length(src);
+  { make sure we don't access char 1 if length is 0 (JM) }
+  if len > 0 then
+    widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+  len := length(temp);
+  if len > length(res) then
+    len := length(res);
+{$r-}
+  move(temp[1],res[0],len*sizeof(widechar));
+  fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
+{$ifdef RangeCheckWasOn}
+{$r+}
+{$endif}
+end;
+
+{$endif ndef FPC_STRTOCHARARRAYPROC}
+
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
 {
   Compares 2 WideStrings;