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

* no heap dump if program has an heap error !

Browse Source
This commit is contained in:
pierre 1999-02-16 17:20:26 +00:00
parent 38575e17a0
commit 710ab457d7
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
rtl/inc/heaptrc.pp
View File

@ -47,7 +47,7 @@ const
exact_info_size : longint = 0; exact_info_size : longint = 0;
{ function to fill this info up } { function to fill this info up }
fill_extra_info : FillExtraInfoType = nil; fill_extra_info : FillExtraInfoType = nil;
error_in_heap : boolean = false;
type type
pheap_mem_info = ^theap_mem_info; pheap_mem_info = ^theap_mem_info;
{ warning the size of theap_mem_info { warning the size of theap_mem_info
@ -217,11 +217,13 @@ begin
RunError(204); RunError(204);
if pp^.sig=$AAAAAAAA then if pp^.sig=$AAAAAAAA then
begin begin
error_in_heap:=true;
dump_already_free(pp); dump_already_free(pp);
if haltonerror then halt(1); if haltonerror then halt(1);
end end
else if pp^.sig<>$DEADBEEF then else if pp^.sig<>$DEADBEEF then
begin begin
error_in_heap:=true;
dump_error(pp); dump_error(pp);
{ don't release anything in this case !! } { don't release anything in this case !! }
if haltonerror then halt(1); if haltonerror then halt(1);
@ -229,6 +231,7 @@ begin
end end
else if pp^.size<>size then else if pp^.size<>size then
begin begin
error_in_heap:=true;
dump_wrong_size(pp,size); dump_wrong_size(pp,size);
if haltonerror then halt(1); if haltonerror then halt(1);
{ don't release anything in this case !! } { don't release anything in this case !! }
@ -332,6 +335,7 @@ var
procedure TraceExit; procedure TraceExit;
begin begin
ExitProc:=SaveExit; ExitProc:=SaveExit;
if not error_in_heap then
Dumpheap; Dumpheap;
end; end;
@ -360,7 +364,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.9 1999-01-22 12:39:22 pierre Revision 1.10 1999-02-16 17:20:26 pierre
* no heap dump if program has an heap error !
Revision 1.9 1999/01/22 12:39:22 pierre
+ added text arg for dump_stack + added text arg for dump_stack
Revision 1.8 1998/12/15 23:49:51 michael Revision 1.8 1998/12/15 23:49:51 michael