Sergei Gorelkin wrote:
>
No, it wasn't the last one, found yet another :(
Again, nothing in testsuite could detect it, so I wrote one.
A thing to note is that two last tests (pchar_to_widestr and
chararray_to_widestr) currently don't fail at least on win32 because
compiler keeps generating a temp widestring for function result.
This may indicate issues with typeconv nodes handling.
The attached RTL patch is 'safe' in the sense it is independent of
compiler changes and wouldn't break the old code - just slow it down a
tiny bit.
program tst2;
{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
var
a: array[0..0] of char = (#0);
function test_pchar: boolean;
var
s: string;
p: pchar;
begin
p := '';
s := '1234567890';
s := p;
test_pchar := (s = '');
if not test_pchar then writeln('test_pchar failed');
end;
function test_chararray: boolean;
var
s: string;
begin
s := '1234567890';
s := a;
test_chararray := (s = '');
if not test_chararray then writeln('test_chararray failed');
end;
function test_pchar_to_widestr: boolean;
var
s: widestring;
p: PChar;
begin
p := '';
s := '1234567890';
s := p; { win32: function result assign not
optimized! }
test_pchar_to_widestr := (s = '');
if not test_pchar_to_widestr then writeln('test_pchar_to_widestr failed');
end;
function test_chararray_to_widestr: boolean;
var
s: widestring;
begin
s := '1234567890';
s := a;
test_chararray_to_widestr := (s = '');
if not test_chararray_to_widestr then writeln('test_chararray_to_widestr
failed');
end;
begin
if not test_pchar then Halt(1);
if not test_chararray then Halt(2);
if not test_pchar_to_widestr then Halt(3);
if not test_chararray_to_widestr then Halt(4);
end.Index: astrings.inc
===================================================================
--- astrings.inc (revision 9893)
+++ astrings.inc (working copy)
@@ -409,11 +409,12 @@
L : SizeInt;
begin
if (not assigned(p)) or (p[0]=#0) Then
- { result is automatically set to '' }
- exit;
- l:=IndexChar(p^,-1,#0);
+ L := 0
+ else
+ l:=IndexChar(p^,-1,#0);
SetLength(fpc_PChar_To_AnsiStr,L);
- Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L)
+ if L > 0 then
+ Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L)
end;
@@ -425,16 +426,19 @@
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;
+ i := 0
+ else
+ begin
+ i:=IndexChar(arr,high(arr)+1,#0);
+ if i = -1 then
+ i := high(arr)+1;
+ end;
end
else
i := high(arr)+1;
SetLength(fpc_CharArray_To_AnsiStr,i);
- Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
+ if i > 0 then
+ Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
end;
{$ifndef FPC_STRTOCHARARRAYPROC}
Index: wustrings.inc
===================================================================
--- wustrings.inc (revision 9893)
+++ wustrings.inc (working copy)
@@ -719,8 +719,10 @@
L : SizeInt;
begin
if (not assigned(p)) or (p[0]=#0) Then
- { result is automatically set to '' }
+ begin
+ fpc_pchar_to_widestr := '';
exit;
+ end;
l:=IndexChar(p^,-1,#0);
widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
end;
@@ -733,8 +735,10 @@
if (zerobased) then
begin
if (arr[0]=#0) Then
- { result is automatically set to '' }
+ begin
+ fpc_chararray_to_widestr := '';
exit;
+ end;
i:=IndexChar(arr,high(arr)+1,#0);
if i = -1 then
i := high(arr)+1;
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
