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

Always write filename, truncate directory part if needed

Browse Source 
git-svn-id: trunk@34362 -
This commit is contained in:
pierre 2016-08-21 22:24:07 +00:00
parent 8d1467157c
commit eefdf135a5
1 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
compiler/ppheap.pas
View File

@ -44,6 +44,9 @@ implementation
Filename registration Filename registration
*****************************************************************************} *****************************************************************************}
{ We need to avoid using memory allocation here
and thus use a fixed size static array }
const const
MaxFiles = 1024; MaxFiles = 1024;
MaxNameLength = 39; MaxNameLength = 39;
@ -62,11 +65,24 @@ implementation
procedure ppheap_register_file(name : string;index : longint); procedure ppheap_register_file(name : string;index : longint);
var
len,pos : longint;
begin begin
inc(last_index); inc(last_index);
if last_index <= MaxFiles then if last_index <= MaxFiles then
begin begin
fileinfoarray[last_index].name:=copy(name,1,MaxNameLength); { Keep last part of name if too long }
len:=length(name);
if len>MaxNameLength then
begin
pos:=len-MaxNameLength+4;
fileinfoarray[last_index].name:='...'+copy(name,pos,MaxNameLength);
end
else
begin
pos:=1;
fileinfoarray[last_index].name:=copy(name,pos,MaxNameLength);
end;
fileinfoarray[last_index].index:=index; fileinfoarray[last_index].index:=index;
end end
else else