paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 20:59:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: compiler test: test for empty directories before expanding filename

Browse Source 
git-svn-id: trunk@11660 -
This commit is contained in:
mattias 2007-07-28 12:07:45 +00:00
parent 923e29b086
commit cf1bba1034
1 changed files with 40 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
ide/checkcompileropts.pas
View File

@ -289,7 +289,9 @@ end;
function TCheckCompilerOptsDlg.CheckCompilerConfig( function TCheckCompilerOptsDlg.CheckCompilerConfig(
const CompilerFilename: string; out FPCCfgUnitPath: string): TModalResult; const CompilerFilename: string; out FPCCfgUnitPath: string): TModalResult;
var
TestDir: String;
procedure ProcessOutputLine(const Line: string); procedure ProcessOutputLine(const Line: string);
const const
USING_UNIT_PATH = 'USING UNIT PATH: '; USING_UNIT_PATH = 'USING UNIT PATH: ';
@ -329,18 +331,24 @@ function TCheckCompilerOptsDlg.CheckCompilerConfig(
then begin then begin
Inc(CurPos, length(USING_UNIT_PATH)); Inc(CurPos, length(USING_UNIT_PATH));
NewPath:=copy(Line,CurPos,len); NewPath:=copy(Line,CurPos,len);
if not FilenameIsAbsolute(NewPath) then begin if NewPath<>'' then begin
AddWarning('relative unit path found in fpc cfg: '+NewPath); if not FilenameIsAbsolute(NewPath) then begin
NewPath:=ExpandFileName(NewPath); AddWarning('relative unit path found in fpc cfg: '+NewPath);
NewPath:=ExpandFileName(NewPath);
end;
NewPath:=AppendPathDelim(TrimFilename(NewPath));
if (CompareFilenames(NewPath,Options.BaseDirectory)<>0)
and (CompareFilenames(NewPath,TestDir)<>0)
then begin
//DebugLn(['TCheckCompilerOptsDlg.CheckCompilerConfig: Using unit path: "',NewPath,'"']);
FPCCfgUnitPath:=FPCCfgUnitPath+NewPath+';';
end;
end; end;
//DebugLn(['TCheckCompilerOptsDlg.CheckCompilerConfig: Using unit path: "',NewPath,'"']);
FPCCfgUnitPath:=FPCCfgUnitPath+NewPath+';';
end; end;
end; end;
end; end;
var var
TestDir: String;
ATestPascalFile: String; ATestPascalFile: String;
CurCompilerOptions: String; CurCompilerOptions: String;
TargetOS: String; TargetOS: String;
@ -378,7 +386,7 @@ begin
if FileExistsCached(CodeToolBoss.DefinePool.EnglishErrorMsgFilename) then if FileExistsCached(CodeToolBoss.DefinePool.EnglishErrorMsgFilename) then
CmdLine:=CmdLine+'-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename+' ' CmdLine:=CmdLine+'-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename+' '
else else
AddWarning('Missing english message file for fpc: components/codetools/fpc.errore.msg'); AddWarning('english message file for fpc is missing: components/codetools/fpc.errore.msg');
if CurCompilerOptions<>'' then if CurCompilerOptions<>'' then
CmdLine:=CmdLine+CurCompilerOptions+' '; CmdLine:=CmdLine+CurCompilerOptions+' ';
@ -388,6 +396,8 @@ begin
TheProcess.CommandLine := CmdLine; TheProcess.CommandLine := CmdLine;
TheProcess.Options:= [poUsePipes, poStdErrToOutPut]; TheProcess.Options:= [poUsePipes, poStdErrToOutPut];
TheProcess.ShowWindow := swoHide; TheProcess.ShowWindow := swoHide;
TheProcess.CurrentDirectory:=Options.BaseDirectory;
//DebugLn(['TCheckCompilerOptsDlg.CheckCompilerConfig Options.BaseDirectory=',Options.BaseDirectory]);
try try
TheProcess.Execute; TheProcess.Execute;
OutputLine:=''; OutputLine:='';
@ -415,9 +425,9 @@ begin
until OutLen=0; until OutLen=0;
TheProcess.WaitOnExit; TheProcess.WaitOnExit;
finally finally
//DebugLn('TDefinePool.CreateFPCTemplate Run with -va: OutputLine="',OutputLine,'"');
TheProcess.Free; TheProcess.Free;
end; end;
FPCCfgUnitPath:=TrimSearchPath(FPCCfgUnitPath,'');
Result:=mrOk; Result:=mrOk;
end; end;
@ -632,23 +642,28 @@ begin
WarnedDirectories:=TStringList.Create; WarnedDirectories:=TStringList.Create;
p:=1; p:=1;
while p<=length(FPCCfgUnitPath) do begin while p<=length(FPCCfgUnitPath) do begin
Directory:=CleanAndExpandDirectory(GetNextDirectoryInSearchPath(FPCCfgUnitPath,p)); Directory:=TrimFilename(GetNextDirectoryInSearchPath(FPCCfgUnitPath,p));
if (Directory<>'') and (WarnedDirectories.IndexOf(Directory)<0) then begin if (Directory<>'') then begin
if SysUtils.FindFirst(Directory+GetAllFilesMask,faAnyFile,FileInfo)=0 Directory:=CleanAndExpandDirectory(GetNextDirectoryInSearchPath(FPCCfgUnitPath,p));
then begin if (Directory<>'') and (FilenameIsAbsolute(Directory))
repeat and (WarnedDirectories.IndexOf(Directory)<0) then begin
// check if special file DebugLn(['TCheckCompilerOptsDlg.CheckFPCUnitPathsContainSources Directory="',Directory,'"']);
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then if SysUtils.FindFirst(Directory+GetAllFilesMask,faAnyFile,FileInfo)=0
continue; then begin
// check extension repeat
if FilenameIsPascalUnit(FileInfo.Name) then begin // check if special file
AddWarning('FPC unit path contains a source: '+Directory+FileInfo.Name); if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
WarnedDirectories.Add(Directory); continue;
break; // check extension
end; if FilenameIsPascalUnit(FileInfo.Name) then begin
until SysUtils.FindNext(FileInfo)<>0; AddWarning('FPC unit path contains a source: '+Directory+FileInfo.Name);
WarnedDirectories.Add(Directory);
break;
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
end; end;
SysUtils.FindClose(FileInfo);
end; end;
end; end;
WarnedDirectories.Free; WarnedDirectories.Free;