* made chararray handling 98% TP-compatible, fixes web bugs 3012

    and 4080. The compatibility differences are:
      a) writing a chararray which is zero-based but not zero-
         terminated does not cause a buffer overflow
      b) non-zero-based chararrays can also be read

    The difference was that previously, all chararrays were treated
    as pchars. In TP/Delphi (and now also in FPC), this is only done
    for zero-based chararrays. For non-zero-based ones, the entire
    contents of the array should always be used (including #0's).

    The default parameters in the system unit for the chararray
    helpers are to avoid having to use a define for bootstrapping.

git-svn-id: trunk@2152 -

.gitattributes

@@ -6385,6 +6385,7 @@ tests/webtbs/tw2999.pp svneol=native#text/plain
 tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain
+tests/webtbs/tw3012.pp svneol=native#text/plain
 tests/webtbs/tw3023.pp svneol=native#text/plain
 tests/webtbs/tw3028.pp svneol=native#text/plain
 tests/webtbs/tw3038.pp svneol=native#text/plain
@@ -6592,6 +6593,7 @@ tests/webtbs/tw4056.pp svneol=native#text/plain
 tests/webtbs/tw4058.pp svneol=native#text/plain
 tests/webtbs/tw4068.pp svneol=native#text/plain
 tests/webtbs/tw4078.pp svneol=native#text/plain
+tests/webtbs/tw4080.pp svneol=native#text/plain
 tests/webtbs/tw4089.pp svneol=native#text/plain
 tests/webtbs/tw4093.pp svneol=native#text/plain
 tests/webtbs/tw4098.pp svneol=native#text/plain

compiler/ncnv.pas

@@ -696,7 +696,9 @@ implementation
           chartype:='char';
         result := ccallnode.createinternres(
            'fpc_'+chartype+'array_to_'+tstringdef(resulttype.def).stringtypname,
-           ccallparanode.create(left,nil),resulttype);
+           ccallparanode.create(cordconstnode.create(
+             ord(tarraydef(left.resulttype.def).lowrange=0),booltype,false),
+           ccallparanode.create(left,nil)),resulttype);
         left := nil;
       end;
 

compiler/ninl.pas

@@ -815,6 +815,12 @@ implementation
                         { add the lenpara (fracpara and realtype are already linked }
                         { with it if necessary)                                     }
                         tcallparanode(para.right).right := lenpara;
+                        { in case of writing a chararray, add whether it's }
+                        { zero-based                                       }
+                        if not(do_read) and
+                           (para.left.resulttype.def.deftype = arraydef) then
+                          para := ccallparanode.create(cordconstnode.create(
+                            ord(tarraydef(para.left.resulttype.def).lowrange=0),booltype,false),para);
                         { create the call statement }
                         addstatement(newstatement,
                           ccallnode.createintern(name,para));

rtl/inc/astrings.inc

@@ -256,15 +256,20 @@ end;
 
 
 
-Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; compilerproc;
+Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
 var
   i  : SizeInt;
 begin
-  if arr[0]=#0 Then
-    { result is automatically set to '' }
-    exit;
-  i:=IndexChar(arr,high(arr)+1,#0);
-  if i = -1 then
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+        { result is automatically set to '' }
+        exit;
+      i:=IndexChar(arr,high(arr)+1,#0);
+      if i = -1 then
+        i := high(arr)+1;
+    end
+  else
     i := high(arr)+1;
   SetLength(fpc_CharArray_To_AnsiStr,i);
   Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);

rtl/inc/compproc.inc

@@ -45,7 +45,7 @@ function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
 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):shortstring; compilerproc;
+function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
 function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
 
 Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
@@ -119,7 +119,7 @@ function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): s
 Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
 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): ansistring; compilerproc;
+Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
 function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
 Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
 Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
@@ -143,13 +143,13 @@ Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
 Function fpc_WideStr_Concat (const S1,S2 : WideString) : WideString; compilerproc;
 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): WideString; compilerproc;
+Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
 function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
-Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar): shortstring; 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): AnsiString; 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): WideString; 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;
 Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
 Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
@@ -167,7 +167,7 @@ Function fpc_get_output:PText;compilerproc;
 Procedure fpc_Write_End(var f:Text); compilerproc;
 Procedure fpc_Writeln_End(var f:Text); compilerproc;
 Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;
-Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); compilerproc;
 Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); compilerproc;
 Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; const S : AnsiString); compilerproc;
 Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideString); compilerproc;

rtl/inc/generic.inc

@@ -618,9 +618,9 @@ end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
 
-function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
+function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
 var
-  l: longint;
+ l: longint;
  index: longint;
  len: byte;
 begin
@@ -629,11 +629,16 @@ begin
     l:=255
   else if l<0 then
     l:=0;
-  index:=IndexByte(arr[0],l,0);
-  if (index < 0) then
-    len := l
+  if (zerobased) then
+    begin
+      index:=IndexByte(arr[0],l,0);
+      if (index < 0) then
+        len := l
+      else
+        len := index;
+    end
   else
-    len := index;
+    len := l;
   move(arr[0],fpc_chararray_to_shortstr[1],len);
   fpc_chararray_to_shortstr[0]:=chr(len);
 end;

rtl/inc/text.inc

@@ -538,7 +538,7 @@ End;
 { provide local access to write_str }
 procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];
 
-Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char; zerobased: boolean = true); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; compilerproc;
 var
   ArrayLen : longint;
   p : pchar;
@@ -549,11 +549,16 @@ Begin
     fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
       begin
         p:=pchar(@s);
-        { can't use StrLen, since that one could try to read past the end }
-        { of the heap (JM)                                                }
-        ArrayLen:=IndexByte(p^,high(s)+1,0);
-        { IndexByte returns -1 if not found (JM) }
-        if ArrayLen = -1 then
+        if (zerobased) then
+          begin
+            { can't use StrLen, since that one could try to read past the end }
+            { of the heap (JM)                                                }
+            ArrayLen:=IndexByte(p^,high(s)+1,0);
+            { IndexByte returns -1 if not found (JM) }
+            if ArrayLen = -1 then
+              ArrayLen := high(s)+1;
+          end
+        else
           ArrayLen := high(s)+1;
         If Len>ArrayLen Then
           fpc_WriteBlanks(f,Len-ArrayLen);

rtl/inc/wstrings.inc

@@ -438,21 +438,27 @@ begin
   widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
 end;
 
-Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; compilerproc;
+Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
 var
   i  : SizeInt;
 begin
-  if arr[0]=#0 Then
-    { result is automatically set to '' }
-    exit;
-  i:=IndexChar(arr,high(arr)+1,#0);
-  if i = -1 then
+  if (zerobased) then
+    begin
+      if (arr[0]=#0) Then
+        { result is automatically set to '' }
+        exit;
+      i:=IndexChar(arr,high(arr)+1,#0);
+      if i = -1 then
+        i := high(arr)+1;
+    end 
+  else
     i := high(arr)+1;
   SetLength(fpc_CharArray_To_WideStr,i);
   widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
 end;
 
-function fpc_WideCharArray_To_ShortStr(const arr: array of widechar): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
+
+function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
 var
   l: longint;
  index: longint;
@@ -464,39 +470,47 @@ begin
     l:=255
   else if l<0 then
     l:=0;
-  index:=IndexWord(arr[0],l,0);
-  if (index < 0) then
-    len := l
+  if zerobased then
+    begin
+      index:=IndexWord(arr[0],l,0);
+      if (index < 0) then
+        len := l
+      else
+        len := index;
+    end
   else
-    len := index;
+    len := l;
   widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
   fpc_WideCharArray_To_ShortStr := temp;
-  //fpc_WideCharArray_To_ShortStr[0]:=chr(len);
 end;
 
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar): AnsiString; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
 var
   i  : SizeInt;
 begin
-  if arr[0]=#0 Then
-    { result is automatically set to '' }
-    exit;
-  i:=IndexWord(arr,high(arr)+1,0);
-  if i = -1 then
+  if (zerobased) then
+    begin
+      i:=IndexWord(arr,high(arr)+1,0);
+      if i = -1 then
+        i := high(arr)+1;
+    end 
+  else
     i := high(arr)+1;
   SetLength(fpc_WideCharArray_To_AnsiStr,i);
   widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),fpc_WideCharArray_To_AnsiStr,i);
 end;
 
-Function fpc_WideCharArray_To_WideStr(const arr: array of widechar): WideString; compilerproc;
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 var
   i  : SizeInt;
 begin
-  if arr[0]=#0 Then
-    { result is automatically set to '' }
-    exit;
-  i:=IndexWord(arr,high(arr)+1,0);
-  if i = -1 then
+  if (zerobased) then
+    begin
+      i:=IndexWord(arr,high(arr)+1,0);
+      if i = -1 then
+        i := high(arr)+1;
+    end 
+  else
     i := high(arr)+1;
   SetLength(fpc_WideCharArray_To_WideStr,i);
   Move(pwidechar(@arr)^, PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1]))^,i*sizeof(WideChar));

tests/webtbs/tw3012.pp

@@ -0,0 +1,22 @@
+Type Char2=Array[1..2] of char;
+
+var C1,C2:Char2;
+    st:string;
+
+Procedure WriteLength(s:string; shouldbe: longint);
+begin
+  WriteLn(s+' ',Length(s));
+  if length(s) <> shouldbe then
+    halt(1);
+end;
+
+begin
+  C1:=#0#65;
+  C2:=#66#0;
+  st:=C1+C2;
+  WriteLength(st,4);	{BP:4; FP:1}
+  WriteLength(C1,2);	{BP:2; FP:0}
+  WriteLength(C2,2);	{BP:2; FP:1}
+  WriteLength(C1+C2,4);	{BP:4; FP:1}
+  WriteLength(C2+C1,4);	{BP:4; FP:1}
+end.

tests/webtbs/tw4080.pp

@@ -0,0 +1,49 @@
+program tw4080;
+{$i+}
+
+{$ifdef unix}
+uses
+  cwstring;
+{$endif unix}
+
+var
+  S, S2 : array [1..15] of char;
+  f: text;
+  f2: file;
+  l: longint;
+  str: shortstring;
+  astr: ansistring;
+  wstr: widestring;
+begin
+  S := 'string1'#0'string2';
+  assign(f,'tw4080.out');
+  rewrite(f);
+  write (f,S);
+  close(f);
+  assign(f2,'tw4080.out');
+  reset(f2,1);
+  if (filesize(f2) <> 15) then
+    halt(1);
+  blockread(f2,s2,sizeof(s2));
+  close(f2);
+  erase(f2);
+  for l := low(s) to high(s) do
+    if s[l] <> s2[l] then
+      halt(1);
+
+  str := s;
+  for l := low(s) to high(s) do
+    if s[l] <> str[l] then
+      halt(1);
+
+  astr := s;
+  for l := low(s) to high(s) do
+    if s[l] <> astr[l] then
+      halt(1);
+  wstr := s;
+  for l := low(s) to high(s) do
+    if s[l] <> wstr[l] then
+      halt(1);
+end.
+
+