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

IDE/lazbuild: simplified TestBuildDirectory, when checking if project needs compile check if target file exists

Browse Source 
git-svn-id: trunk@48406 -
This commit is contained in:
mattias 2015-03-17 13:30:53 +00:00
parent a6a61ddf51
commit 7760e5b734
11 changed files with 54 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ide/basebuildmanager.pas
View File

@ -64,7 +64,6 @@ type
function GetProjectPublishDir: string; virtual; abstract;
function GetProjectTargetFilename(aProject: TProject): string; virtual; abstract;
function GetProjectUsesAppBundle: Boolean; virtual; abstract;
function GetTestProjectFilename(aProject: TProject): string; virtual; abstract;
function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; virtual; abstract;
function GetTestBuildDirectory: string; virtual; abstract;
function IsTestUnitFilename(const AFilename: string): boolean; virtual; abstract;

50
ide/buildmanager.pas
View File

@ -188,7 +188,6 @@ type
function GetProjectPublishDir: string; override;
function GetProjectTargetFilename(aProject: TProject): string; override;
function GetProjectUsesAppBundle: Boolean; override;
function GetTestProjectFilename(aProject: TProject): string; override;
function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; override;
function GetTestBuildDirectory: string; override;
function IsTestUnitFilename(const AFilename: string): boolean; override;
@ -682,15 +681,8 @@ begin
if aProject=nil then exit;
Result:=aProject.RunParameterOptions.HostApplicationFilename;
GlobalMacroList.SubstituteStr(Result);
if Result='' then begin
if aProject.IsVirtual then
Result:=GetTestProjectFilename(aProject)
else begin
if aProject.MainUnitID>=0 then begin
Result :=
aProject.CompilerOptions.CreateTargetFilename(aProject.MainFilename);
end;
end;
if (Result='') and (aProject.MainUnitID>=0) then begin
Result := aProject.CompilerOptions.CreateTargetFilename;
end;
end;
@ -701,24 +693,6 @@ begin
and (GetTargetOS = 'darwin') and Project1.UseAppBundle;
end;
function TBuildManager.GetTestProjectFilename(aProject: TProject): string;
var
TestDir: String;
begin
Result:='';
if aProject=nil then exit;
if (aProject.MainUnitID<0) then exit;
Result:=GetTestUnitFilename(aProject.MainUnitInfo);
if Result='' then exit;
Result:=aProject.CompilerOptions.CreateTargetFilename(Result);
if Result='' then exit;
if (not FilenameIsAbsolute(Result)) then begin
TestDir:=GetTestBuildDirectory;
if TestDir='' then exit;
Result:=TestDir+Result;
end;
end;
function TBuildManager.GetTestUnitFilename(AnUnitInfo: TUnitInfo): string;
var
TestDir: String;
@ -1123,6 +1097,7 @@ var
AnUnitInfo: TUnitInfo;
LFMFilename: String;
IcoRes: TProjectIcon;
aTargetFilename: String;
function EditorFileHasChanged: boolean;
begin
@ -1174,7 +1149,7 @@ begin
//DebugLn(['TBuildManager.DoCheckIfProjectNeedsCompilation CompilerFilename="',CompilerFilename,'" CompilerPath="',AProject.CompilerOptions.CompilerPath,'"']);
// Note: use absolute paths, because some external tools resolve symlinked directories
CompilerParams :=
AProject.CompilerOptions.MakeOptionsString(SrcFilename,[ccloAbsolutePaths])
AProject.CompilerOptions.MakeOptionsString([ccloAbsolutePaths])
+ ' ' + PrepareCmdLineOption(SrcFilename);
//DebugLn('TBuildManager.DoCheckIfProjectNeedsCompilation WorkingDir="',WorkingDir,'" SrcFilename="',SrcFilename,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
@ -1334,6 +1309,16 @@ begin
exit(mrYes);
end;
// check target file
aTargetFilename:=AProject.CompilerOptions.CreateTargetFilename;
debugln(['TBuildManager.DoCheckIfProjectNeedsCompilation aTargetFilename=',aTargetFilename]);
if (aTargetFilename<>'') and not FileExistsCached(aTargetFilename) then begin
if ConsoleVerbosity>=0 then
debugln(['TBuildManager.DoCheckIfProjectNeedsCompilation missing target file "',aTargetFilename,'"']);
Note+='Project''s target file "'+aTargetFilename+'" is missing.';
exit(mrYes);
end;
Result:=mrNo;
end;
@ -1621,12 +1606,7 @@ begin
Result := False;
if Project1.MainUnitInfo = nil then
Exit;
if Project1.IsVirtual then
TargetExeName := GetTestBuildDirectory +
ExtractFilename(Project1.MainUnitInfo.Filename)
else
TargetExeName := Project1.CompilerOptions.CreateTargetFilename(
Project1.MainFilename);
TargetExeName := Project1.CompilerOptions.CreateTargetFilename;
if not (CreateApplicationBundle(TargetExeName, Project1.GetTitle, True) in
[mrOk, mrIgnore]) then

2
ide/checkcompileropts.pas
View File

@ -327,7 +327,7 @@ begin
end;
try
// create compiler command line options
CmdLineParams:=Options.MakeOptionsString(BogusFilename,
CmdLineParams:=Options.MakeOptionsString(
[ccloAddVerboseAll,ccloDoNotAppendOutFileOption,ccloAbsolutePaths])
+' '+BogusFilename;
CompileTool:=ExternalToolList.Add(dlgCCOTestToolCompilingEmptyFile);

5
ide/compiler.pp
View File

@ -278,7 +278,7 @@ var
TargetFilename: String;
begin
Result:=mrCancel;
if ConsoleVerbosity>=0 then
if ConsoleVerbosity>=1 then
DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
try
@ -323,8 +323,7 @@ begin
if TargetCPU<>GetCompiledTargetCPU then
Title+=Format(lisCPU, [TargetCPU]);
TargetFilename:=AProject.GetShortFilename(
AProject.CompilerOptions.CreateTargetFilename(AProject.MainFilename),
false);
AProject.CompilerOptions.CreateTargetFilename,false);
if TargetFilename<>'' then
Title+=Format(lisTarget2, [TargetFilename]);

52
ide/compileroptions.pp
View File

@ -486,12 +486,10 @@ type
procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); override;
function MakeOptionsString(Flags: TCompilerCmdLineOptions): String;
function MakeOptionsString(const MainSourceFileName: string;
Flags: TCompilerCmdLineOptions): String; virtual;
function MakeOptionsString(Flags: TCompilerCmdLineOptions): String; virtual;
function GetSyntaxOptionsString: string; virtual;
function CreatePPUFilename(const SourceFileName: string): string; override;
function CreateTargetFilename(const MainSourceFileName: string): string; virtual;
function CreateTargetFilename: string; virtual;
function GetTargetFileExt: string; virtual;
function GetTargetFilePrefix: string; virtual;
procedure GetInheritedCompilerOptions(var OptionsList: TFPList // list of TAdditionalCompilerOptions
@ -1903,8 +1901,7 @@ end;
{------------------------------------------------------------------------------
TBaseCompilerOptions CreateTargetFilename
------------------------------------------------------------------------------}
function TBaseCompilerOptions.CreateTargetFilename(
const MainSourceFileName: string): string;
function TBaseCompilerOptions.CreateTargetFilename: string;
procedure AppendDefaultExt;
var
@ -1952,13 +1949,20 @@ function TBaseCompilerOptions.CreateTargetFilename(
var
UnitOutDir: String;
OutFilename: String;
Dir: String;
begin
Result:=TargetFilename;
if Assigned(ParsedOpts.OnLocalSubstitute) then
if Result='' then
begin
Result:=ParsedOpts.OnLocalSubstitute(Result,false);
// the compiler cuts off the source extension
TargetFilename:=ExtractFileNameOnly(GetDefaultMainSourceFileName);
end else begin
Result:=ParseString(ParsedOpts,Result,false);
if Assigned(ParsedOpts.OnLocalSubstitute) then
begin
Result:=ParsedOpts.OnLocalSubstitute(Result,false);
end else begin
Result:=ParseString(ParsedOpts,Result,false);
end;
end;
if (Result<>'') and FilenameIsAbsolute(Result) then begin
// fully specified target filename
@ -1971,9 +1975,13 @@ begin
if UnitOutDir='' then
UnitOutDir:=BaseDirectory;
Result:=AppendPathDelim(UnitOutDir)+ExtractFileName(Result);
end else begin
end else if BaseDirectory<>'' then begin
// the program is put relative to the base directory
Result:=CreateAbsolutePath(Result,BaseDirectory);
end else begin
// put into test directory
Dir:=EnvironmentOptions.GetParsedTestBuildDirectory;
Result:=CreateAbsolutePath(Result,Dir);
end;
end else begin
// no target given => put into unit output directory
@ -1981,7 +1989,9 @@ begin
UnitOutDir:=GetUnitOutPath(false);
if UnitOutDir='' then
UnitOutDir:=BaseDirectory;
OutFilename:=ExtractFileNameOnly(MainSourceFileName);
if UnitOutDir='' then
UnitOutDir:=EnvironmentOptions.GetParsedTestBuildDirectory;
OutFilename:=ExtractFileNameOnly(GetDefaultMainSourceFileName);
//debugln('TBaseCompilerOptions.CreateTargetFilename MainSourceFileName=',MainSourceFileName,' OutFilename=',OutFilename,' TargetFilename=',TargetFilename,' UnitOutDir=',UnitOutDir);
Result:=CreateAbsolutePath(OutFilename,UnitOutDir);
end;
@ -2434,15 +2444,6 @@ begin
Result:=ShortenSearchPath(Result,BaseDirectory,BaseDirectory);
end;
{------------------------------------------------------------------------------
TBaseCompilerOptions MakeOptionsString
------------------------------------------------------------------------------}
function TBaseCompilerOptions.MakeOptionsString(
Flags: TCompilerCmdLineOptions): String;
begin
Result:=MakeOptionsString(GetDefaultMainSourceFileName,Flags);
end;
{------------------------------------------------------------------------------
function TBaseCompilerOptions.MakeOptionsString(
const MainSourceFilename: string;
@ -2451,7 +2452,7 @@ end;
Get all the options and create a string that can be passed to the compiler
------------------------------------------------------------------------------}
function TBaseCompilerOptions.MakeOptionsString(
const MainSourceFileName: string; Flags: TCompilerCmdLineOptions): String;
Flags: TCompilerCmdLineOptions): String;
var
switches, tempsw, t: String;
InhLinkerOpts: String;
@ -2487,10 +2488,6 @@ var
end;
begin
CurMainSrcFile:=MainSourceFileName;
if CurMainSrcFile='' then
CurMainSrcFile:=GetDefaultMainSourceFileName;
switches := '';
{ options of fpc 2.7.1 :
@ -3057,12 +3054,13 @@ begin
{ * -o to define the target file name.
* -FE if the target file name is not in the project directory (where the lpi file is)
* -FU if the unit output directory is not empty }
CurMainSrcFile:=GetDefaultMainSourceFileName;
//DebugLn(['TBaseCompilerOptions.MakeOptionsString ',DbgSName(Self),' ',ccloDoNotAppendOutFileOption in Flags,' TargetFilename="',TargetFilename,'" CurMainSrcFile="',CurMainSrcFile,'" CurOutputDir="',CurOutputDir,'"']);
if (not (ccloDoNotAppendOutFileOption in Flags))
and (not (ccloNoMacroParams in Flags))
and ((TargetFilename<>'') or (CurMainSrcFile<>'') or (CurOutputDir<>'')) then
begin
NewTargetFilename := CreateTargetFilename(CurMainSrcFile);
NewTargetFilename := CreateTargetFilename;
if (NewTargetFilename<>'') then
begin
if not (ccloAbsolutePaths in Flags) then
@ -3922,6 +3920,8 @@ function TParsedCompilerOptions.DoParseOption(const OptionText: string;
Result:=GetParsedPIValue(pcosBaseDir)
else
Result:=GetParsedValue(pcosBaseDir);
if Result='' then
Result:=EnvironmentOptions.GetParsedTestBuildDirectory;
end;
procedure MakeFilenameAbsolute(var aFilename: string);

3
ide/frames/project_application_options.pas
View File

@ -86,8 +86,7 @@ begin
TargetExeName := LazarusIDE.GetTestBuildDirectory +
ExtractFilename(AProject.MainUnitInfo.Filename)
else
TargetExeName := AProject.CompilerOptions.CreateTargetFilename(
AProject.MainFilename);
TargetExeName := AProject.CompilerOptions.CreateTargetFilename;
if not (CreateApplicationBundle(TargetExeName, AProject.GetTitle, True) in
[mrOk, mrIgnore]) then

2
ide/lazbuild.lpi
View File

@ -57,11 +57,11 @@
<Unit2>
<Filename Value="basebuildmanager.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BaseBuildManager"/>
</Unit2>
<Unit3>
<Filename Value="idecmdline.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="IDECmdLine"/>
</Unit3>
</Units>
</ProjectOptions>

15
ide/lazbuild.lpr
View File

@ -86,8 +86,6 @@ type
// project
procedure OnProjectChangeInfoFile(TheProject: TProject);
procedure OnProjectGetTestDirectory({%H-}TheProject: TProject; out
TestDir: string);
// dialogs
function OnIDEMessageDialog(const aCaption, aMsg: string;
@ -317,12 +315,6 @@ begin
Project1.ProjectDirectory)
end;
procedure TLazBuildApplication.OnProjectGetTestDirectory(TheProject: TProject;
out TestDir: string);
begin
TestDir:=BuildBoss.GetTestBuildDirectory;
end;
function TLazBuildApplication.OnIDEMessageDialog(const aCaption, aMsg: string;
DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; const HelpKeyword: string
): Integer;
@ -802,7 +794,7 @@ var
Error(ErrorBuildFailed,'Unable to create project unit output directory '+UnitOutputDirectory);
// create target output directory
TargetExeName := Project1.CompilerOptions.CreateTargetFilename(Project1.MainFilename);
TargetExeName := Project1.CompilerOptions.CreateTargetFilename;
TargetExeDir := ExtractFilePath(TargetExeName);
if not ForceDirectory(TargetExeDir) then
Error(ErrorBuildFailed,'Unable to create project target directory '+TargetExeDir);
@ -834,7 +826,7 @@ var
CompilerFilename:=Project1.GetCompilerFilename;
//DebugLn(['TLazBuildApplication.BuildProject CompilerFilename="',CompilerFilename,'" CompilerPath="',Project1.CompilerOptions.CompilerPath,'"']);
// CompileHint: use absolute paths, same as TBuildManager.DoCheckIfProjectNeedsCompilation
CompilerParams:=Project1.CompilerOptions.MakeOptionsString(SrcFilename,[ccloAbsolutePaths])
CompilerParams:=Project1.CompilerOptions.MakeOptionsString([ccloAbsolutePaths])
+' '+PrepareCmdLineOption(SrcFilename);
NeedBuildAllFlag:=false;
@ -842,7 +834,7 @@ var
if (crCompile in Project1.CompilerOptions.CompileReasons) then begin
// check if project is already uptodate
SubResult:=MainBuildBoss.DoCheckIfProjectNeedsCompilation(Project1,
NeedBuildAllFlag,CompileHint);
NeedBuildAllFlag,CompileHint);
if (not BuildAll)
and (not (pfAlwaysBuild in Project1.Flags)) then begin
if SubResult=mrNo then begin
@ -976,7 +968,6 @@ begin
Result.MainProject:=true;
Result.OnFileBackup:=@BuildBoss.BackupFile;
Result.OnGetTestDirectory:=@OnProjectGetTestDirectory;
Result.OnChangeProjectInfoFile:=@OnProjectChangeInfoFile;
finally

14
ide/main.pp
View File

@ -691,7 +691,6 @@ type
XMLConfig: TXMLConfig; Merge: boolean);
procedure OnSaveProjectInfoToXMLConfig(TheProject: TProject;
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags);
procedure OnProjectGetTestDirectory(TheProject: TProject; out TestDir: string);
procedure OnProjectChangeInfoFile(TheProject: TProject);
procedure OnSaveProjectUnitSessionInfo(AUnitInfo: TUnitInfo);
public
@ -5683,12 +5682,6 @@ begin
EditorMacroListViewer.SaveProjectSpecificInfo(XMLConfig, WriteFlags);
end;
procedure TMainIDE.OnProjectGetTestDirectory(TheProject: TProject; out TestDir: string);
begin
if TheProject=nil then ;
TestDir:=GetTestBuildDirectory;
end;
procedure TMainIDE.OnProjectChangeInfoFile(TheProject: TProject);
begin
if (Project1=nil) or (TheProject<>Project1) then exit;
@ -6283,7 +6276,6 @@ begin
Result.OnLoadProjectInfo:=@OnLoadProjectInfoFromXMLConfig;
Result.OnSaveProjectInfo:=@OnSaveProjectInfoToXMLConfig;
Result.OnSaveUnitSessionInfo:=@OnSaveProjectUnitSessionInfo;
Result.OnGetTestDirectory:=@OnProjectGetTestDirectory;
Result.OnChangeProjectInfoFile:=@OnProjectChangeInfoFile;
Result.IDEOptions.OnBeforeRead:=@DoProjectOptionsBeforeRead;
Result.IDEOptions.OnAfterWrite:=@DoProjectOptionsAfterWrite;
@ -6813,9 +6805,7 @@ begin
end;
// create target output directory
TargetExeName := Project1.CompilerOptions.CreateTargetFilename(Project1.MainFilename);
if Project1.IsVirtual and (not FilenameIsAbsolute(TargetExeName)) then
TargetExeName := GetTestBuildDirectory + TargetExeName;
TargetExeName := Project1.CompilerOptions.CreateTargetFilename;
TargetExeDirectory:=ExtractFilePath(TargetExeName);
if (FilenameIsAbsolute(TargetExeDirectory))
and (not DirPathExistsCached(TargetExeDirectory)) then begin
@ -6883,7 +6873,7 @@ begin
CompilerFilename:=Project1.GetCompilerFilename;
// Hint: use absolute paths, because some external tools resolve symlinked directories
CompilerParams :=
Project1.CompilerOptions.MakeOptionsString(SrcFilename,[ccloAbsolutePaths])
Project1.CompilerOptions.MakeOptionsString([ccloAbsolutePaths])
+ ' ' + PrepareCmdLineOption(SrcFilename);
// write state file, to avoid building clean every time
Result:=Project1.SaveStateFile(CompilerFilename,CompilerParams,false);

19
ide/project.pp
View File

@ -76,8 +76,6 @@ type
Merge: boolean) of object;
TOnSaveProjectInfo = procedure(TheProject: TProject;
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags) of object;
TOnProjectGetTestDirectory = procedure(TheProject: TProject;
out TestDir: string) of object;
TOnChangeProjectInfoFile = procedure(TheProject: TProject) of object;
TOnSaveUnitSessionInfoInfo = procedure(AUnitInfo: TUnitInfo) of object;
@ -752,7 +750,6 @@ type
FOnChangeProjectInfoFile: TOnChangeProjectInfoFile;
FOnEndUpdate: TEndUpdateProjectEvent;
fOnFileBackup: TOnFileBackup;
FOnGetTestDirectory: TOnProjectGetTestDirectory;
FOnLoadProjectInfo: TOnLoadProjectInfo;
FOnSaveProjectInfo: TOnSaveProjectInfo;
FOnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo;
@ -1026,7 +1023,6 @@ type
function GetOutputDirectory: string;
function GetCompilerFilename: string;
function GetStateFilename: string;
function GetTestDirectory: string;
function GetCompileSourceFilename: string;
procedure AutoAddOutputDirToIncPath;
@ -1096,8 +1092,6 @@ type
write FOnChangeProjectInfoFile;
property OnEndUpdate: TEndUpdateProjectEvent read FOnEndUpdate write FOnEndUpdate;
property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup;
property OnGetTestDirectory: TOnProjectGetTestDirectory read FOnGetTestDirectory
write FOnGetTestDirectory;
property OnLoadProjectInfo: TOnLoadProjectInfo read FOnLoadProjectInfo
write FOnLoadProjectInfo;
property OnSaveProjectInfo: TOnSaveProjectInfo read FOnSaveProjectInfo
@ -4822,10 +4816,7 @@ end;
function TProject.GetOutputDirectory: string;
begin
if IsVirtual then
Result:=GetTestDirectory
else
Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir);
Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir);
end;
function TProject.GetCompilerFilename: string;
@ -4841,14 +4832,6 @@ begin
Result:=AppendPathDelim(Result)+ChangeFileExt(GetCompileSourceFilename,'.compiled');
end;
function TProject.GetTestDirectory: string;
begin
if Assigned(OnGetTestDirectory) then
OnGetTestDirectory(Self,Result)
else
Result:=GetCurrentDirUTF8;
end;
function TProject.GetCompileSourceFilename: string;
begin
if MainUnitID<0 then

5
packager/packagedefs.pas
View File

@ -370,7 +370,7 @@ type
function GetOwnerName: string; override;
procedure InvalidateOptions;
function GetDefaultMainSourceFileName: string; override;
function CreateTargetFilename(const {%H-}MainSourceFileName: string): string; override;
function CreateTargetFilename: string; override;
function HasCompilerCommand: boolean; override;
procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string); override;
@ -4161,8 +4161,7 @@ begin
Result:=inherited GetDefaultMainSourceFileName;
end;
function TPkgCompilerOptions.CreateTargetFilename(
const MainSourceFileName: string): string;
function TPkgCompilerOptions.CreateTargetFilename: string;
begin
Result:='';
end;