paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* reallocation of widestrings on windows fixed

Browse Source 
* warnings in sstrings.inc fixed

git-svn-id: trunk@500 -
This commit is contained in:
florian 2005-06-26 08:17:21 +00:00
parent 822f7f0f16
commit ed95c19399
3 changed files with 25 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
rtl/inc/sstrings.inc
View File

@ -57,7 +57,7 @@ end;
procedure insert(const source : shortstring;var s : shortstring;index : SizeInt);
var
cut,srclen,indexlen : longint;
cut,srclen,indexlen : SizeInt;
begin
if index<1 then
index:=1;
@ -65,9 +65,9 @@ begin
index:=length(s)+1;
indexlen:=Length(s)-Index+1;
srclen:=length(Source);
if length(source)+length(s)>=sizeof(s) then
if SizeInt(length(source)+length(s))>=sizeof(s) then
begin
cut:=length(source)+length(s)-sizeof(s)+1;
cut:=SizeInt(length(source)+length(s))-sizeof(s)+1;
if cut>indexlen then
begin
dec(srclen,cut-indexlen);
@ -84,7 +84,7 @@ end;
procedure insert(source : Char;var s : shortstring;index : SizeInt);
var
indexlen : longint;
indexlen : SizeInt;
begin
if index<1 then
index:=1;

21
rtl/inc/wstrings.inc
View File

@ -117,6 +117,13 @@ end;
Internal functions, not in interface.
****************************************************************************}
procedure WideStringError;
begin
HandleErrorFrame(204,get_frame);
end;
{$ifdef WideStrDebug}
Procedure DumpWideRec(S : Pointer);
begin
@ -149,12 +156,14 @@ begin
GetMem(P,Len*sizeof(WideChar)+WideRecLen);
{$endif MSWINDOWS}
If P<>Nil then
begin
begin
PWideRec(P)^.Len:=0; { Initial length }
PWideRec(P)^.Ref:=1; { Set reference count }
PWideRec(P)^.First:=#0; { Terminating #0 }
inc(p,WideFirstOff); { Points to string now }
end;
end
else
WideStringError;
NewWideString:=P;
end;
@ -615,13 +624,19 @@ begin
{ Need a complete new string...}
Pointer(s):=NewWideString(l);
end
{ windows doesn't support reallocing widestrings, this code
is anyways subject to be removed because widestrings shouldn't be
ref. counted anymore (FK) }
{$ifndef MSWINDOWS}
else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
begin
Dec(Pointer(S),WideFirstOff);
if L*sizeof(WideChar)+WideRecLen>MemSize(Pointer(S)) then
reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
end;
Inc(Pointer(S), WideFirstOff);
end
{$endif MSWINDOWS}
else
begin
{ Reallocation is needed... }

4
rtl/win32/system.pp
View File

@ -114,12 +114,14 @@ implementation
{ used by wstrings.inc because wstrings.inc is included before sysos.inc
this is put here (FK) }
function SysAllocStringLen(psz:pointer;len:Integer):pointer;stdcall;
function SysAllocStringLen(psz:pointer;len:dword):pointer;stdcall;
external 'oleaut32.dll' name 'SysAllocStringLen';
procedure SysFreeString(bstr:pointer);stdcall;
external 'oleaut32.dll' name 'SysFreeString';
function SysReAllocStringLen(var bstr:pointer;psz: pointer;
len:dword): Integer; stdcall;external 'oleaut32.dll' name 'SysReAllocStringLen';
{ include system independent routines }