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

* optimize fixpath, findfile to not require temp ansistrings

Browse Source 
* check for verbosity for V_Tried level messages, patches from Sergei Gorelkin

git-svn-id: trunk@9297 -
This commit is contained in:
peter 2007-11-19 22:24:52 +00:00
parent cb24c78d4d
commit 241c65d5ec
5 changed files with 62 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
compiler/cfileutl.pas
View File

@ -117,12 +117,12 @@ interface
Function FileExists (const F : TCmdStr;allowcache:boolean) : Boolean;
function FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
Function RemoveDir(d:TCmdStr):boolean;
Function FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
Function FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr;
function FixFileName(const s:TCmdStr):TCmdStr;
function TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
function TargetFixFileName(const s:TCmdStr):TCmdStr;
procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr);
function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
function FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
{ function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;}
function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
function GetShortName(const n:TCmdStr):TCmdStr;
@ -523,7 +523,7 @@ implementation
else
{$endif usedircache}
Result:=SysUtils.FileExists(F);
if assigned(do_comment) then
if do_checkverbosity(V_Tried) then
begin
if Result then
do_comment(V_Tried,'Searching file '+F+'... found')
@ -652,27 +652,37 @@ implementation
end;
Function FixPath(s:TCmdStr;allowdot:boolean):TCmdStr;
Function FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr;
var
i : longint;
i, L : longint;
P: PChar;
begin
Result := s;
L := Length(Result);
if L=0 then
exit;
{ Fix separator }
for i:=1 to length(s) do
if s[i] in ['/','\'] then
s[i]:=source_info.DirSep;
P := @Result[1];
for i:=0 to L-1 do
begin
if p^ in ['/','\'] then
p^:=source_info.DirSep;
inc(p);
end;
{ Fix ending / }
if (length(s)>0) and (s[length(s)]<>source_info.DirSep) and
(s[length(s)]<>DriveSeparator) then
s:=s+source_info.DirSep;
if (L>0) and (Result[L]<>source_info.DirSep) and
(Result[L]<>DriveSeparator) then
Result:=Result+source_info.DirSep; { !still results in temp AnsiString }
{ Remove ./ }
if (not allowdot) and (s='.'+source_info.DirSep) then
s:='';
if (not allowdot) and ((Length(Result)=2) and (Result[1]='.') and (Result[2] = source_info.DirSep)) then
begin
Result:='';
Exit;
end;
{ return }
if (tf_files_case_aware in source_info.flags) or
(tf_files_case_sensitive in source_info.flags) then
FixPath:=s
else
FixPath:=Lower(s);
if not ((tf_files_case_aware in source_info.flags) or
(tf_files_case_sensitive in source_info.flags)) then
Result := lower(Result);
end;
{Actually the version in macutils.pp could be used,
@ -945,7 +955,7 @@ implementation
procedure WarnNonExistingPath(const path : TCmdStr);
begin
if assigned(do_comment) then
if do_checkverbosity(V_Tried) then
do_comment(V_Tried,'Path "'+path+'" not found');
end;
@ -1134,26 +1144,22 @@ implementation
end;
function FindFile(const f : TCmdStr;path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
Var
singlepathstring : TCmdStr;
i : longint;
function FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
Var
StartPos, EndPos, L: LongInt;
begin
if PathSeparator <> ';' then
for i:=1 to length(path) do
if path[i]=PathSeparator then
path[i]:=';';
FindFile:=false;
Result:=False;
StartPos := 1;
L := Length(Path);
repeat
i:=pos(';',path);
if i=0 then
i:=Succ (Length (Path));
singlepathstring:=FixPath(copy(path,1,i-1),false);
delete(path,1,i);
result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile);
if result then
exit;
until path='';
EndPos := StartPos;
while (EndPos <= L) and ((Path[EndPos] <> PathSeparator) and (Path[EndPos] <> ';')) do
Inc(EndPos);
Result := FileExistsNonCase(FixPath(Copy(Path, StartPos, EndPos-StartPos), False), f, allowcache, FoundFile);
if Result then
Exit;
StartPos := EndPos + 1;
until StartPos > L;
FoundFile:=f;
end;

2
compiler/cmsgs.pas
View File

@ -383,7 +383,7 @@ begin
if hp=nil then
Get:='msg nr '+tostr(nr)
else
Get:=MsgReplace(strpas(hp),args);
Get:=MsgReplace(system.strpas(hp),args);
end;
end.

9
compiler/comphook.pas
View File

@ -124,6 +124,7 @@ var
Function def_status:boolean;
Function def_comment(Level:Longint;const s:ansistring):boolean;
function def_internalerror(i:longint):boolean;
function def_CheckVerbosity(v:longint):boolean;
procedure def_initsymbolinfo;
procedure def_donesymbolinfo;
procedure def_extractsymbolinfo;
@ -135,6 +136,7 @@ type
tstatusfunction = function:boolean;
tcommentfunction = function(Level:Longint;const s:ansistring):boolean;
tinternalerrorfunction = function(i:longint):boolean;
tcheckverbosityfunction = function(i:longint):boolean;
tinitsymbolinfoproc = procedure;
tdonesymbolinfoproc = procedure;
@ -146,6 +148,7 @@ const
do_status : tstatusfunction = @def_status;
do_comment : tcommentfunction = @def_comment;
do_internalerror : tinternalerrorfunction = @def_internalerror;
do_checkverbosity : tcheckverbosityfunction = @def_checkverbosity;
do_initsymbolinfo : tinitsymbolinfoproc = @def_initsymbolinfo;
do_donesymbolinfo : tdonesymbolinfoproc = @def_donesymbolinfo;
@ -369,6 +372,12 @@ begin
def_internalerror:=true;
end;
function def_CheckVerbosity(v:longint):boolean;
begin
result:=status.use_bugreport or
((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
end;
procedure def_initsymbolinfo;
begin
end;

12
compiler/fppu.pas
View File

@ -265,7 +265,8 @@ uses
Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
begin
Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
UnitExists:=FindFile(FileName+ext,Singlepathstring,true,foundfile);
end;
@ -382,16 +383,19 @@ uses
begin
{ the full filename is specified so we can't use here the
searchpath (PFV) }
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
fnd:=FindFile(ChangeFileExt(sourcefn^,sourceext),'',true,hs);
if not fnd then
begin
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
fnd:=FindFile(ChangeFileExt(sourcefn^,pasext),'',true,hs);
end;
if not fnd and ((m_mac in current_settings.modeswitches) or (tf_p_ext_support in target_info.flags)) then
begin
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
if CheckVerbosity(V_Tried) then
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
fnd:=FindFile(ChangeFileExt(sourcefn^,pext),'',true,hs);
end;
if fnd then

3
compiler/verbose.pas
View File

@ -180,8 +180,7 @@ implementation
function CheckVerbosity(v:longint):boolean;
begin
CheckVerbosity:=status.use_bugreport or
((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
result:=do_checkverbosity(v);
end;