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

instantfpc: fixed showing compiler error

Browse Source 
git-svn-id: trunk@25340 -
This commit is contained in:
Mattias Gaertner 2013-08-23 13:47:07 +00:00
parent add4aa10df
commit 1e48781694
1 changed files with 37 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
utils/instantfpc/instantfptools.pas
View File

@ -282,6 +282,15 @@ var
pid: SizeUInt; pid: SizeUInt;
BuildDir: String; BuildDir: String;
BuildOutputFilename: String; BuildOutputFilename: String;
procedure CleanUp;
begin
if BuildDir<>'' then begin
// delete build directory
DeleteDirectory(BuildDir);
end;
end;
begin begin
Compiler:=GetCompiler; Compiler:=GetCompiler;
pid:=GetProcessID; pid:=GetProcessID;
@ -307,34 +316,37 @@ begin
Halt(1); Halt(1);
end; end;
end; end;
CompParams:=GetCompilerParameters(CacheFilename,BuildDir,BuildOutputFilename); try
Proc:=TProcess.Create(nil); CompParams:=GetCompilerParameters(CacheFilename,BuildDir,BuildOutputFilename);
Proc.CommandLine:=Compiler+' '+CompParams; Proc:=TProcess.Create(nil);
{$WARNING Unconditional use of pipes breaks for targets not supporting them} Proc.CommandLine:=Compiler+' '+CompParams;
Proc.Options:= [poUsePipes, poStdErrToOutput]; {$WARNING Unconditional use of pipes breaks for targets not supporting them}
Proc.ShowWindow := swoHide; Proc.Options:= [poUsePipes, poStdErrToOutput];
Proc.Execute; Proc.ShowWindow := swoHide;
ss:=TStringStream.Create(''); Proc.Execute;
repeat ss:=TStringStream.Create('');
Count:=Proc.Output.Read(Buf{%H-},4096); repeat
if Count>0 then Count:=Proc.Output.Read(Buf{%H-},4096);
ss.write(buf,count); if Count>0 then
until Count=0; ss.write(buf,count);
if BuildDir<>'' then begin until Count=0;
// move from build directory to cache if (not Proc.WaitOnExit) or (Proc.ExitStatus<>0) then begin
if not RenameFile(BuildOutputFilename,OutputFilename) then begin WriteCompilerOutput(SrcFilename,BuildOutputFilename,ss.DataString);
writeln('unable to move "',BuildOutputFilename,'" to "',OutputFilename,'"'); CleanUp;
Halt(1); Halt(1);
end; end;
// delete build directory if BuildDir<>'' then begin
DeleteDirectory(BuildDir); // move from build directory to cache
if not RenameFile(BuildOutputFilename,OutputFilename) then begin
writeln('unable to move "',BuildOutputFilename,'" to "',OutputFilename,'"');
Halt(1);
end;
end;
ss.Free;
Proc.Free;
finally
CleanUp;
end; end;
if (not Proc.WaitOnExit) or (Proc.ExitStatus<>0) then begin
WriteCompilerOutput(SrcFilename,CacheFilename,ss.DataString);
Halt(1);
end;
ss.Free;
Proc.Free;
end; end;
function GetCompilerParameters(const SrcFilename, OutputDirectory, function GetCompilerParameters(const SrcFilename, OutputDirectory,