paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-16 06:42:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

TCompiler: IFDEFed all async changes

Browse Source 
git-svn-id: trunk@24603 -
This commit is contained in:
martin 2010-04-12 15:49:20 +00:00
parent 7b05020246
commit 0d9ddd4c01
1 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
ide/compiler.pp
View File

@ -47,6 +47,7 @@ type
TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
of object; of object;
{$IFDEF WithAsyncCompile}
TBuildProjectData = class TBuildProjectData = class
public public
Reason: TCompileReason; Reason: TCompileReason;
@ -54,35 +55,46 @@ type
CompilerFilename: String; CompilerFilename: String;
CompilerParams: String; CompilerParams: String;
end; end;
{$ENDIF}
{ TCompiler } { TCompiler }
TCompiler = class(TObject) TCompiler = class(TObject)
private private
{$IFDEF WithAsyncCompile}
FASyncResult: TModalResult; FASyncResult: TModalResult;
{$ENDIF}
FOnCmdLineCreate : TOnCmdLineCreate; FOnCmdLineCreate : TOnCmdLineCreate;
FOutputFilter: TOutputFilter; FOutputFilter: TOutputFilter;
FTheProcess: TProcessUTF8; FTheProcess: TProcessUTF8;
FOldCurDir: string; FOldCurDir: string;
{$IFDEF WithAsyncCompile}
FFinishedCallback: TNotifyEvent; FFinishedCallback: TNotifyEvent;
procedure CompilationFinished(Sender: TObject); procedure CompilationFinished(Sender: TObject);
{$ENDIF}
{$IFDEF WithAsyncCompile}
public public
// Values stored by caller, to be rtrieved on callback // Values stored by caller, to be rtrieved on callback
CallerData: TObject; CallerData: TObject;
{$ENDIF}
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
function Compile(AProject: TProject; function Compile(AProject: TProject;
const WorkingDir, CompilerFilename, CompilerParams: string; const WorkingDir, CompilerFilename, CompilerParams: string;
BuildAll, SkipLinking, SkipAssembler: boolean; BuildAll, SkipLinking, SkipAssembler: boolean
aFinishedCallback: TNotifyEvent = nil {$IFDEF WithAsyncCompile}
; aFinishedCallback: TNotifyEvent = nil
{$ENDIF}
): TModalResult; ): TModalResult;
procedure WriteError(const Msg: string); procedure WriteError(const Msg: string);
property OnCommandLineCreate: TOnCmdLineCreate read FOnCmdLineCreate property OnCommandLineCreate: TOnCmdLineCreate read FOnCmdLineCreate
write FOnCmdLineCreate; write FOnCmdLineCreate;
property OutputFilter: TOutputFilter read FOutputFilter write FOutputFilter; property OutputFilter: TOutputFilter read FOutputFilter write FOutputFilter;
property TheProcess: TProcessUTF8 read FTheProcess; property TheProcess: TProcessUTF8 read FTheProcess;
{$IFDEF WithAsyncCompile}
property ASyncResult: TModalResult read FASyncResult; property ASyncResult: TModalResult read FASyncResult;
{$ENDIF}
end; end;
@ -114,15 +126,18 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TCompiler.Compile(AProject: TProject; function TCompiler.Compile(AProject: TProject;
const WorkingDir, CompilerFilename, CompilerParams: string; const WorkingDir, CompilerFilename, CompilerParams: string;
BuildAll, SkipLinking, SkipAssembler: boolean; BuildAll, SkipLinking, SkipAssembler: boolean
aFinishedCallback: TNotifyEvent = nil): TModalResult; {$IFDEF WithAsyncCompile} ; aFinishedCallback: TNotifyEvent = nil {$ENDIF}
): TModalResult;
var var
CmdLine : String; CmdLine : String;
Abort : Boolean; Abort : Boolean;
begin begin
Result:=mrCancel; Result:=mrCancel;
{$IFDEF WithAsyncCompile}
FASyncResult:= mrNone; FASyncResult:= mrNone;
FFinishedCallback := aFinishedCallback; FFinishedCallback := aFinishedCallback;
{$ENDIF}
DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"'); DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
// if we want to show the compile progress, it's now time to show the dialog // if we want to show the compile progress, it's now time to show the dialog
@ -188,16 +203,19 @@ begin
if OutputFilter<>nil then begin if OutputFilter<>nil then begin
OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError]; OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError];
OutputFilter.CompilerOptions:=AProject.CompilerOptions; OutputFilter.CompilerOptions:=AProject.CompilerOptions;
{$IFDEF WithAsyncCompile}
if aFinishedCallback <> nil then begin if aFinishedCallback <> nil then begin
OutputFilter.ExecuteAsyncron(TheProcess, @CompilationFinished, Self); OutputFilter.ExecuteAsyncron(TheProcess, @CompilationFinished, Self);
end else end else
{$ENDIF}
OutputFilter.Execute(TheProcess,Self); OutputFilter.Execute(TheProcess,Self);
end else begin end else begin
TheProcess.Execute; TheProcess.Execute;
end; end;
finally finally
if TheProcess.Running and ((OutputFilter = nil) or (aFinishedCallback = nil)) then if TheProcess.Running
begin {$IFDEF WithAsyncCompile} and ((OutputFilter = nil) or (aFinishedCallback = nil)) {$ENDIF}
then begin
TheProcess.WaitOnExit; TheProcess.WaitOnExit;
if not (TheProcess.ExitStatus in [0,1]) then begin if not (TheProcess.ExitStatus in [0,1]) then begin
WriteError(Format(listCompilerInternalError,[TheProcess.ExitStatus])); WriteError(Format(listCompilerInternalError,[TheProcess.ExitStatus]));
@ -223,6 +241,7 @@ begin
DebugLn('[TCompiler.Compile] end'); DebugLn('[TCompiler.Compile] end');
end; end;
{$IFDEF WithAsyncCompile}
procedure TCompiler.CompilationFinished(Sender: TObject); procedure TCompiler.CompilationFinished(Sender: TObject);
begin begin
FASyncResult:= mrOK; FASyncResult:= mrOK;
@ -238,6 +257,7 @@ begin
if assigned(FFinishedCallback) then if assigned(FFinishedCallback) then
FFinishedCallback(Self); FFinishedCallback(Self);
end; end;
{$ENDIF}
procedure TCompiler.WriteError(const Msg: string); procedure TCompiler.WriteError(const Msg: string);
begin begin