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

IDE: when compiling project to test build directory delete all ppu and o files

Browse Source 
git-svn-id: trunk@56863 -
This commit is contained in:
mattias 2017-12-28 10:50:32 +00:00
parent 6001e4b474
commit fc39438535
1 changed files with 48 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
ide/main.pp
View File

@ -800,6 +800,7 @@ type
function DoBuildProject(const AReason: TCompileReason;
Flags: TProjectBuildFlags;
FinalizeResources: boolean = True): TModalResult; override;
function CleanUpTestUnitOutputDir(Dir: string): TModalResult;
function UpdateProjectPOFile(AProject: TProject): TModalResult;
function DoAbortBuild(Interactive: boolean): TModalResult;
procedure DoCompile;
@ -6762,19 +6763,28 @@ begin
UnitOutputDirectory:=Project1.CompilerOptions.GetUnitOutPath(false);
if Project1.IsVirtual and (not FilenameIsAbsolute(UnitOutputDirectory)) then
UnitOutputDirectory:=TrimFilename(WorkingDir+PathDelim+UnitOutputDirectory);
if (FilenameIsAbsolute(UnitOutputDirectory))
and (not DirPathExistsCached(UnitOutputDirectory)) then begin
if not FileIsInPath(UnitOutputDirectory,WorkingDir) then begin
Result:=IDEQuestionDialog(lisCreateDirectory,
Format(lisTheOutputDirectoryIsMissing, [UnitOutputDirectory]),
mtConfirmation, [mrYes, lisCreateIt,
mrCancel]);
if Result<>mrYes then exit;
if FilenameIsAbsolute(UnitOutputDirectory) then begin
if (not DirPathExistsCached(UnitOutputDirectory)) then begin
if not FileIsInPath(UnitOutputDirectory,WorkingDir) then begin
Result:=IDEQuestionDialog(lisCreateDirectory,
Format(lisTheOutputDirectoryIsMissing, [UnitOutputDirectory]),
mtConfirmation, [mrYes, lisCreateIt,
mrCancel]);
if Result<>mrYes then exit;
end;
Result:=ForceDirectoryInteractive(UnitOutputDirectory,[mbRetry]);
if Result<>mrOk then begin
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] ForceDirectoryInteractive "',UnitOutputDirectory,'" failed']);
exit;
end;
end;
Result:=ForceDirectoryInteractive(UnitOutputDirectory,[mbRetry]);
if Result<>mrOk then begin
debugln(['Error: (lazarus) [TMainIDE.DoBuildProject] ForceDirectoryInteractive "',UnitOutputDirectory,'" failed']);
exit;
if Project1.IsVirtual
and (FileIsInPath(UnitOutputDirectory,EnvironmentOptions.GetParsedTestBuildDirectory))
then begin
// clean up test units
Result:=CleanUpTestUnitOutputDir(UnitOutputDirectory);
if Result<>mrOk then
exit;
end;
end;
@ -6905,6 +6915,32 @@ begin
Result:=mrOk;
end;
function TMainIDE.CleanUpTestUnitOutputDir(Dir: string): TModalResult;
var
Files: TStrings;
i: Integer;
Filename, Ext: String;
begin
Dir:=AppendPathDelim(Dir);
Files:=TStringListUTF8.Create;
try
CodeToolBoss.DirectoryCachePool.GetListing(Dir,Files,false);
for i:=0 to Files.Count-1 do begin
Filename:=Files[i];
Ext:=ExtractFileExt(Filename);
if (SysUtils.CompareText(Ext,'.ppu')=0)
or (SysUtils.CompareText(Ext,'.o')=0)
then begin
Result:=DeleteFileInteractive(Dir+Filename,[]);
if Result<>mrOk then exit;
end;
end;
InvalidateFileStateCache(Dir);
finally
Files.Free;
end;
end;
function TMainIDE.DoAbortBuild(Interactive: boolean): TModalResult;
begin
Result:=mrOk;