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

+ Fix crash when resizing dynamic array

Browse Source
This commit is contained in:
michael 2004-09-15 07:28:09 +00:00
parent cabdb71f2a
commit 5cccea2115
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/inc/dynarr.inc
View File

@ -90,9 +90,13 @@ procedure fpc_dynarray_clear_internal(p : pointer;ti : pointer);
procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_CLEAR']; {$ifdef hascompilerproc} compilerproc; {$endif} procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_CLEAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
var
realp : pdynarray;
begin begin
if (P=Nil) then if (P=Nil) then
exit; exit;
realp:=pdynarray(p-sizeof(tdynarray));
if declocked(realp^.refcount) then
fpc_dynarray_clear_internal(p-sizeof(tdynarray),ti); fpc_dynarray_clear_internal(p-sizeof(tdynarray),ti);
p:=nil; p:=nil;
end; end;
@ -195,13 +199,14 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
else else
begin begin
realp:=pdynarray(p-sizeof(tdynarray)); realp:=pdynarray(p-sizeof(tdynarray));
newp := realp;
if dims[dimcount-1]<0 then
HandleErrorFrame(201,get_frame);
{ if the new dimension is 0, we've to release all data } { if the new dimension is 0, we've to release all data }
if dims[dimcount-1]=0 then if dims[dimcount-1]<=0 then
begin begin
if dims[dimcount-1]<0 then
HandleErrorFrame(201,get_frame);
if declocked(realp^.refcount) then
fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(pti)); fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(pti));
p:=nil; p:=nil;
exit; exit;
@ -236,7 +241,6 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
end end
else if dims[dimcount-1]<>realp^.high+1 then else if dims[dimcount-1]<>realp^.high+1 then
begin begin
{ range checking is quite difficult ... } { range checking is quite difficult ... }
{ if size overflows then it is less than } { if size overflows then it is less than }
{ the values it was calculated from } { the values it was calculated from }
@ -344,7 +348,10 @@ procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
{ {
$Log$ $Log$
Revision 1.28 2004-05-31 20:25:04 peter Revision 1.29 2004-09-15 07:28:09 michael
+ Fix crash when resizing dynamic array
Revision 1.28 2004/05/31 20:25:04 peter
* removed warnings * removed warnings
Revision 1.27 2004/05/31 14:31:57 peter Revision 1.27 2004/05/31 14:31:57 peter