mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-03 12:03:49 +02:00
2836 lines
87 KiB
ObjectPascal
2836 lines
87 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Parser for Free Pascal Compiler output.
|
|
}
|
|
unit etFPCMsgParser;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{off $DEFINE VerboseFPCMsgUnitNotFound}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, strutils, math, FileProcs, KeywordFuncLists,
|
|
IDEExternToolIntf, PackageIntf, LazIDEIntf, ProjectIntf, IDEUtils,
|
|
CompOptsIntf, CodeToolsFPCMsgs, CodeToolsStructs, CodeCache, CodeToolManager,
|
|
DirectoryCacher, BasicCodeTools, DefineTemplates, SourceLog, LazUTF8,
|
|
FileUtil, LConvEncoding, LazFileUtils,
|
|
LazConf, TransferMacros, etMakeMsgParser,
|
|
EnvironmentOpts, LCLProc, LazarusIDEStrConsts;
|
|
|
|
const
|
|
FPCMsgIDLogo = 11023;
|
|
FPCMsgIDCantFindUnitUsedBy = 10022;
|
|
FPCMsgIDLinking = 9015;
|
|
FPCMsgIDErrorWhileLinking = 9013;
|
|
FPCMsgIDErrorWhileCompilingResources = 9029;
|
|
FPCMsgIDCallingResourceCompiler = 9028;
|
|
FPCMsgIDThereWereErrorsCompiling = 10026;
|
|
FPCMsgIDMethodIdentifierExpected = 3047;
|
|
FPCMsgIDIdentifierNotFound = 5000;
|
|
FPCMsgIDChecksumChanged = 10028;
|
|
|
|
FPCMsgAttrWorkerDirectory = 'WD';
|
|
FPCMsgAttrMissingUnit = 'MissingUnit';
|
|
FPCMsgAttrUsedByUnit = 'UsedByUnit';
|
|
type
|
|
TFPCMsgFilePool = class;
|
|
|
|
{ TFPCMsgFilePoolItem }
|
|
|
|
TFPCMsgFilePoolItem = class
|
|
private
|
|
FMsgFile: TFPCMsgFile;
|
|
FFilename: string;
|
|
FPool: TFPCMsgFilePool;
|
|
FLoadedFileAge: integer;
|
|
fUseCount: integer;
|
|
public
|
|
constructor Create(aPool: TFPCMsgFilePool; const aFilename: string);
|
|
destructor Destroy; override;
|
|
property Pool: TFPCMsgFilePool read FPool;
|
|
property Filename: string read FFilename;
|
|
property LoadedFileAge: integer read FLoadedFileAge;
|
|
function GetMsg(ID: integer): TFPCMsgItem;
|
|
property MsgFile: TFPCMsgFile read FMsgFile;
|
|
property UseCount: integer read fUseCount;
|
|
end;
|
|
|
|
TETLoadFileEvent = procedure(aFilename: string; out s: string) of object;
|
|
|
|
{ TFPCMsgFilePool }
|
|
|
|
TFPCMsgFilePool = class(TComponent)
|
|
private
|
|
fCritSec: TRTLCriticalSection;
|
|
FDefaultEnglishFile: string;
|
|
FDefaultTranslationFile: string;
|
|
FFiles: TFPList; // list of TFPCMsgFilePoolItem sorted for loaded
|
|
FOnLoadFile: TETLoadFileEvent;
|
|
fPendingLog: TStrings;
|
|
fMsgFileStamp: integer;
|
|
fCurrentEnglishFile: string; // valid only if fMsgFileStamp=CompilerParseStamp
|
|
fCurrentTranslationFile: string; // valid only if fMsgFileStamp=CompilerParseStamp
|
|
procedure Log(Msg: string; AThread: TThread);
|
|
procedure LogSync;
|
|
procedure SetDefaultEnglishFile(AValue: string);
|
|
procedure SetDefaultTranslationFile(AValue: string);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function LoadCurrentEnglishFile(UpdateFromDisk: boolean;
|
|
AThread: TThread): TFPCMsgFilePoolItem; // don't forget UnloadFile
|
|
function LoadFile(aFilename: string; UpdateFromDisk: boolean;
|
|
AThread: TThread): TFPCMsgFilePoolItem; // don't forget UnloadFile
|
|
procedure UnloadFile(var aFile: TFPCMsgFilePoolItem);
|
|
procedure EnterCriticalsection;
|
|
procedure LeaveCriticalSection;
|
|
procedure GetMsgFileNames(CompilerFilename, TargetOS, TargetCPU: string;
|
|
out anEnglishFile, aTranslationFile: string); // (main thread)
|
|
property DefaultEnglishFile: string read FDefaultEnglishFile write SetDefaultEnglishFile;
|
|
property DefaulTranslationFile: string read FDefaultTranslationFile write SetDefaultTranslationFile;
|
|
property OnLoadFile: TETLoadFileEvent read FOnLoadFile write FOnLoadFile; // (main or workerthread)
|
|
end;
|
|
|
|
{ TPatternToMsgID }
|
|
|
|
TPatternToMsgID = class
|
|
public
|
|
Pattern: string;
|
|
MsgID: integer;
|
|
end;
|
|
|
|
{ TPatternToMsgIDs }
|
|
|
|
TPatternToMsgIDs = class
|
|
private
|
|
fItems: array of TPatternToMsgID;
|
|
function IndexOf(Pattern: PChar; Insert: boolean): integer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Add(Pattern: string; MsgID: integer);
|
|
procedure AddLines(const Lines: string; MsgID: integer);
|
|
function LineToMsgID(p: PChar): integer; // 0 = not found
|
|
procedure WriteDebugReport;
|
|
procedure ConsistencyCheck;
|
|
end;
|
|
|
|
{ TIDEFPCParser }
|
|
|
|
TIDEFPCParser = class(TFPCParser)
|
|
private
|
|
fCurSource: TCodeBuffer;
|
|
fFileExists: TFilenameToPointerTree;
|
|
fIncludePath: string; // only valid if fIncludePathValidForWorkerDir=Tool.WorkerDirectory
|
|
fIncludePathValidForWorkerDir: string;
|
|
fUnitPath: string; // only valid if fUnitPathValidForWorkerDir=Tool.WorkerDirectory
|
|
fUnitPathValidForWorkerDir: string;
|
|
fLastWorkerImprovedMessage: array[TExtToolParserSyncPhase] of integer;
|
|
fLineToMsgID: TPatternToMsgIDs;
|
|
fMissingFPCMsgItem: TFPCMsgItem;
|
|
fMsgID: Integer; // current message id given by ReadLine (-vq)
|
|
fMsgItemCantFindUnitUsedBy: TFPCMsgItem;
|
|
fMsgItemCompilationAborted: TFPCMsgItem;
|
|
fMsgItemErrorWhileCompilingResources: TFPCMsgItem;
|
|
fMsgItemErrorWhileLinking: TFPCMsgItem;
|
|
fMsgItemMethodIdentifierExpected: TFPCMsgItem;
|
|
fMsgItemIdentifierNotFound: TFPCMsgItem;
|
|
fMsgItemThereWereErrorsCompiling: TFPCMsgItem;
|
|
fMsgItemChecksumChanged: TFPCMsgItem;
|
|
fMsgItemUnitNotUsed: TFPCMsgItem;
|
|
fOutputIndex: integer; // current OutputIndex given by ReadLine
|
|
procedure FetchIncludePath(aPhase: TExtToolParserSyncPhase; MsgWorkerDir: String);
|
|
procedure FetchUnitPath(aPhase: TExtToolParserSyncPhase; MsgWorkerDir: String);
|
|
function FileExists(const Filename: string; aSynchronized: boolean): boolean;
|
|
function CheckForMsgId(p: PChar): boolean; // (MsgId) message
|
|
function CheckForFileLineColMessage(p: PChar): boolean; // the normal messages: filename(y,x): Hint: ..
|
|
function CheckForGeneralMessage(p: PChar): boolean; // Fatal: .., Error: ..., Panic: ..
|
|
function CheckForInfos(p: PChar): boolean;
|
|
function CheckForCompilingState(p: PChar): boolean; // Compiling ..
|
|
function CheckForAssemblingState(p: PChar): boolean; // Assembling ..
|
|
function CheckForLinesCompiled(p: PChar): boolean; // ..lines compiled..
|
|
function CheckForExecutableInfo(p: PChar): boolean;
|
|
function CheckForLineProgress(p: PChar): boolean; // 600 206.521/231.648 Kb Used
|
|
function CheckForLoadFromUnit(p: PChar): Boolean;
|
|
function CheckForWindresErrors(p: PChar): boolean;
|
|
function CreateMsgLine: TMessageLine;
|
|
procedure AddLinkingMessages;
|
|
procedure AddResourceMessages;
|
|
function NeedSource(aPhase: TExtToolParserSyncPhase; SourceOk: boolean): boolean;
|
|
procedure ImproveMsgHiddenByIDEDirective(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine; SourceOK: Boolean);
|
|
procedure ImproveMsgSenderNotUsed(aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine);
|
|
procedure ImproveMsgUnitNotUsed(aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine);
|
|
procedure ImproveMsgUnitNotFound(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine);
|
|
procedure ImproveMsgLinkerUndefinedReference(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine);
|
|
procedure ImproveMsgIdentifierPosition(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine; SourceOK: boolean);
|
|
procedure Translate(p: PChar; MsgItem, TranslatedItem: TFPCMsgItem;
|
|
out TranslatedMsg: String; out MsgType: TMessageLineUrgency);
|
|
function LongenFilename(MsgLine: TMessageLine; aFilename: string): string; // (worker thread)
|
|
public
|
|
DirectoryStack: TStrings;
|
|
MsgFilename: string; // e.g. /path/to/fpcsrc/compiler/msg/errore.msg
|
|
MsgFile: TFPCMsgFilePoolItem;
|
|
TranslationFilename: string; // e.g. /path/to/fpcsrc/compiler/msg/errord.msg
|
|
TranslationFile: TFPCMsgFilePoolItem;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Init; override; // called after macros resolved, before starting thread (main thread)
|
|
procedure InitReading; override; // called if process started, before first line (worker thread)
|
|
procedure Done; override; // called after process stopped (worker thread)
|
|
procedure ReadLine(Line: string; OutputIndex: integer; var Handled: boolean); override;
|
|
procedure AddMsgLine(MsgLine: TMessageLine); override;
|
|
procedure ImproveMessages(aPhase: TExtToolParserSyncPhase); override;
|
|
function GetFPCMsgIDPattern(MsgID: integer): string; override;
|
|
function IsMsgID(MsgLine: TMessageLine; MsgID: integer;
|
|
var Item: TFPCMsgItem): boolean;
|
|
class function IsSubTool(const SubTool: string): boolean; override;
|
|
class function DefaultSubTool: string; override;
|
|
class function GetMsgPattern(SubTool: string; MsgID: integer;
|
|
out Urgency: TMessageLineUrgency): string; override;
|
|
class function GetMsgHint(SubTool: string; MsgID: integer): string;
|
|
override;
|
|
class function Priority: integer; override;
|
|
class function MsgLineIsId(Msg: TMessageLine; MsgId: integer;
|
|
out Value1, Value2: string): boolean; override;
|
|
class function GetFPCMsgPattern(Msg: TMessageLine): string; override;
|
|
class function GetFPCMsgValue1(Msg: TMessageLine): string; override;
|
|
class function GetFPCMsgValues(Msg: TMessageLine; out Value1, Value2: string): boolean; override;
|
|
end;
|
|
|
|
var
|
|
FPCMsgFilePool: TFPCMsgFilePool = nil;
|
|
|
|
// thread safe
|
|
function FPCMsgToMsgUrgency(Msg: TFPCMsgItem): TMessageLineUrgency;
|
|
function FPCMsgTypeToUrgency(const Typ: string): TMessageLineUrgency;
|
|
function TranslateFPCMsg(const Src, SrcPattern, TargetPattern: string): string;
|
|
function FPCMsgFits(const Msg, Pattern: string;
|
|
VarStarts: PPChar = nil; VarEnds: PPChar = nil // 10 PChars
|
|
): boolean;
|
|
function GetFPCMsgValue1(const Src, Pattern: string; out Value1: string): boolean;
|
|
function GetFPCMsgValues2(Src, Pattern: string; out Value1, Value2: string): boolean;
|
|
|
|
// not thread safe
|
|
function IsFileInIDESrcDir(Filename: string): boolean; // (main thread)
|
|
|
|
procedure RegisterFPCParser;
|
|
|
|
implementation
|
|
|
|
function FPCMsgTypeToUrgency(const Typ: string): TMessageLineUrgency;
|
|
begin
|
|
Result:=mluNone;
|
|
if (Typ='') or (length(Typ)<>1) then exit;
|
|
case UpChars[Typ[1]] of
|
|
'F': Result:=mluFatal;
|
|
'E': Result:=mluError;
|
|
'W': Result:=mluWarning;
|
|
'N': Result:=mluNote;
|
|
'H': Result:=mluHint;
|
|
'I': Result:=mluVerbose; // info
|
|
'L': Result:=mluProgress; // line number
|
|
'C': Result:=mluVerbose; // conditional: like IFDEFs
|
|
'U': Result:=mluVerbose2; // used: found files
|
|
'T': Result:=mluVerbose3; // tried: tried paths, general information
|
|
'D': Result:=mluDebug;
|
|
'X': Result:=mluProgress; // e.g. Size of Code
|
|
'O': Result:=mluProgress; // e.g., "press enter to continue"
|
|
else
|
|
Result:=mluNone;
|
|
end;
|
|
end;
|
|
|
|
function FPCMsgToMsgUrgency(Msg: TFPCMsgItem): TMessageLineUrgency;
|
|
begin
|
|
Result:=mluNone;
|
|
if Msg=nil then exit;
|
|
Result:=FPCMsgTypeToUrgency(Msg.ShownTyp);
|
|
if Result<>mluNone then exit;
|
|
Result:=FPCMsgTypeToUrgency(Msg.Typ);
|
|
if Result=mluNone then begin
|
|
//debugln(['FPCMsgToMsgUrgency Msg.ShownTyp="',Msg.ShownTyp,'" Msg.Typ="',Msg.Typ,'"']);
|
|
Result:=mluVerbose3;
|
|
end;
|
|
end;
|
|
|
|
function IsFPCMsgVar(p: PChar): boolean; inline;
|
|
begin
|
|
Result:=(p^='$') and (p[1] in ['0'..'9']);
|
|
end;
|
|
|
|
function IsFPCMsgEndOrVar(p: PChar): boolean; inline;
|
|
begin
|
|
Result:=(p^=#0) or IsFPCMsgVar(p);
|
|
end;
|
|
|
|
function TranslateFPCMsg(const Src, SrcPattern, TargetPattern: string): string;
|
|
{ for example:
|
|
Src='A lines compiled, B sec C'
|
|
SrcPattern='$1 lines compiled, $2 sec $3'
|
|
TargetPattern='$1 Zeilen uebersetzt, $2 Sekunden $3'
|
|
|
|
Result='A Zeilen uebersetzt, B Sekunden C'
|
|
}
|
|
var
|
|
SrcPos: PChar;
|
|
TargetPatPos: PChar;
|
|
TargetPos: PChar;
|
|
SrcVarStarts, SrcVarEnds: array[0..9] of PChar;
|
|
VarUsed: array[0..9] of integer;
|
|
i: Integer;
|
|
begin
|
|
Result:='';
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['TranslateFPCMsg Src="',Src,'" SrcPattern="',SrcPattern,'" TargetPattern="',TargetPattern,'"']);
|
|
{$ENDIF}
|
|
if (Src='') or (SrcPattern='') or (TargetPattern='') then exit;
|
|
|
|
if not FPCMsgFits(Src,SrcPattern,@SrcVarStarts[0],@SrcVarEnds[0]) then
|
|
exit;
|
|
|
|
for i:=Low(SrcVarStarts) to high(SrcVarStarts) do
|
|
VarUsed[i]:=0;
|
|
|
|
// create Target
|
|
SetLength(Result,length(TargetPattern)+length(Src));
|
|
TargetPatPos:=PChar(TargetPattern);
|
|
TargetPos:=PChar(Result);
|
|
while TargetPatPos^<>#0 do begin
|
|
//debugln(['TranslateFPCMsg Target ',dbgs(Pointer(TargetPatPos)),' ',ord(TargetPatPos^),' TargetPatPos="',TargetPatPos,'"']);
|
|
if IsFPCMsgVar(TargetPatPos) then begin
|
|
// insert variable
|
|
inc(TargetPatPos);
|
|
i:=ord(TargetPatPos^)-ord('0');
|
|
inc(TargetPatPos);
|
|
if SrcVarStarts[i]<>nil then begin
|
|
inc(VarUsed[i]);
|
|
if VarUsed[i]>1 then begin
|
|
// variable is used more than once => realloc result
|
|
dec(TargetPos,{%H-}PtrUInt(PChar(Result)));
|
|
SetLength(Result,length(Result)+SrcVarEnds[i]-SrcVarStarts[i]);
|
|
inc(TargetPos,{%H-}PtrUInt(PChar(Result)));
|
|
end;
|
|
SrcPos:=SrcVarStarts[i];
|
|
while SrcPos<SrcVarEnds[i] do begin
|
|
TargetPos^:=SrcPos^;
|
|
inc(TargetPos);
|
|
inc(SrcPos);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// copy text from TargetPattern
|
|
TargetPos^:=TargetPatPos^;
|
|
inc(TargetPatPos);
|
|
inc(TargetPos);
|
|
end;
|
|
end;
|
|
SetLength(Result,TargetPos-PChar(Result));
|
|
if Result<>'' then
|
|
UTF8FixBroken(PChar(Result));
|
|
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['TranslateFPCMsg Result="',Result,'"']);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function FPCMsgFits(const Msg, Pattern: string; VarStarts: PPChar;
|
|
VarEnds: PPChar): boolean;
|
|
{ for example:
|
|
Src='A lines compiled, B sec C'
|
|
SrcPattern='$1 lines compiled, $2 sec $3'
|
|
|
|
VarStarts and VarEnds can be nil.
|
|
If you need the boundaries of the parameters allocate VarStarts and VarEnds as
|
|
VarStarts:=GetMem(SizeOf(PChar)*10);
|
|
VarEnds:=GetMem(SizeOf(PChar)*10);
|
|
VarStarts[0] will be $0, VarStarts[1] will be $1 and so forth
|
|
|
|
}
|
|
var
|
|
MsgPos, PatPos: PChar;
|
|
MsgPos2, PatPos2: PChar;
|
|
i: Integer;
|
|
begin
|
|
Result:=false;
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits Msg="',Msg,'" Pattern="',Pattern,'"']);
|
|
{$ENDIF}
|
|
if (Msg='') or (Pattern='') then exit;
|
|
MsgPos:=PChar(Msg);
|
|
PatPos:=PChar(Pattern);
|
|
// skip the characters of Msg copied from Pattern
|
|
while not IsFPCMsgEndOrVar(PatPos) do begin
|
|
if (MsgPos^<>PatPos^) then begin
|
|
// Pattern does not fit
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits skipping start of Src and SrcPattern failed']);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
inc(MsgPos);
|
|
inc(PatPos)
|
|
end;
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits skipped start: SrcPos="',SrcPos,'" SrcPatPos="',SrcPatPos,'"']);
|
|
{$ENDIF}
|
|
if VarStarts<>nil then begin
|
|
FillByte(VarStarts^,SizeOf(PChar)*10,0);
|
|
FillByte(VarEnds^,SizeOf(PChar)*10,0);
|
|
end;
|
|
// find the parameters in Msg and store their boundaries in VarStarts, VarEnds
|
|
while (PatPos^<>#0) do begin
|
|
// read variable number
|
|
inc(PatPos);
|
|
i:=ord(PatPos^)-ord('0');
|
|
inc(PatPos);
|
|
if (VarEnds<>nil) and (VarEnds[i]=nil) then begin
|
|
VarStarts[i]:=MsgPos;
|
|
VarEnds[i]:=nil;
|
|
end;
|
|
// find the end of the parameter in Msg
|
|
// example: Pattern='$1 found' Msg='Ha found found'
|
|
repeat
|
|
if MsgPos^=PatPos^ then begin
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits candidate for param ',i,' end: SrcPos="',SrcPos,'" SrcPatPos="',SrcPatPos,'"']);
|
|
{$ENDIF}
|
|
MsgPos2:=MsgPos;
|
|
PatPos2:=PatPos;
|
|
while (MsgPos2^=PatPos2^) and not IsFPCMsgEndOrVar(PatPos2) do begin
|
|
inc(MsgPos2);
|
|
inc(PatPos2);
|
|
end;
|
|
if IsFPCMsgEndOrVar(PatPos2) then begin
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits param ',i,' end found: SrcPos2="',SrcPos2,'" SrcPatPos2="',SrcPatPos2,'"']);
|
|
{$ENDIF}
|
|
if (VarEnds<>nil) and (VarEnds[i]=nil) then
|
|
VarEnds[i]:=MsgPos;
|
|
MsgPos:=MsgPos2;
|
|
PatPos:=PatPos2;
|
|
break;
|
|
end;
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits searching further...']);
|
|
{$ENDIF}
|
|
end else if MsgPos^=#0 then begin
|
|
if IsFPCMsgEndOrVar(PatPos) then begin
|
|
// empty parameter at end
|
|
if (VarEnds<>nil) and (VarEnds[i]=nil) then
|
|
VarEnds[i]:=MsgPos;
|
|
break;
|
|
end else begin
|
|
// Pattern does not fit Msg
|
|
{$IFDEF VerboseFPCTranslate}
|
|
debugln(['FPCMsgFits finding end of parameter ',i,' failed']);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
end;
|
|
inc(MsgPos);
|
|
until false;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function GetFPCMsgValue1(const Src, Pattern: string; out Value1: string
|
|
): boolean;
|
|
{ Pattern: 'Compiling $1'
|
|
Src: 'Compiling fcllaz.pas'
|
|
Value1: 'fcllaz.pas'
|
|
}
|
|
var
|
|
p: SizeInt;
|
|
l: SizeInt;
|
|
begin
|
|
Value1:='';
|
|
Result:=false;
|
|
if length(Src)<length(Pattern)-2 then exit;
|
|
p:=Pos('$1',Pattern);
|
|
if p<1 then exit;
|
|
// check start pattern
|
|
if (p>1) and (not CompareMem(Pointer(Src),Pointer(Pattern),p-1)) then exit;
|
|
// check end pattern
|
|
l:=length(Pattern)-p-2;
|
|
if (l>0)
|
|
and (not CompareMem(Pointer(Src)+length(Src)-l,Pointer(Pattern)+p+2,l)) then exit;
|
|
Value1:=copy(Src,p,length(Src)-length(Pattern)+2);
|
|
Result:=true;
|
|
end;
|
|
|
|
function GetFPCMsgValues2(Src, Pattern: string; out Value1, Value2: string
|
|
): boolean;
|
|
{ Pattern: 'Unit $1 was not found but $2 exists'
|
|
Src: 'Unit dialogprocs was not found but dialogpr exists'
|
|
Value1: 'dialogprocs'
|
|
Value1: 'dialogpr'
|
|
Not supported: '$1$2'
|
|
}
|
|
var
|
|
p1: SizeInt;
|
|
LastPattern: String;
|
|
p2: SizeInt;
|
|
MiddlePattern: String;
|
|
SrcP1Behind: Integer;
|
|
SrcP2: Integer;
|
|
begin
|
|
Result:=false;
|
|
Value1:='';
|
|
Value2:='';
|
|
p1:=Pos('$1',Pattern);
|
|
if p1<1 then exit;
|
|
p2:=Pos('$2',Pattern);
|
|
if p2<=p1+2 then exit;
|
|
if LeftStr(Pattern,p1-1)<>LeftStr(Src,p1-1) then exit;
|
|
LastPattern:=RightStr(Pattern,length(Pattern)-p2-1);
|
|
if RightStr(Src,length(LastPattern))<>LastPattern then exit;
|
|
MiddlePattern:=copy(Pattern,p1+2,p2-p1-2);
|
|
SrcP1Behind:=PosEx(MiddlePattern,Src,p1+2);
|
|
if SrcP1Behind<1 then exit;
|
|
Value1:=copy(Src,p1,SrcP1Behind-p1);
|
|
SrcP2:=SrcP1Behind+length(MiddlePattern);
|
|
Value2:=copy(Src,SrcP2,length(Src)-SrcP2-length(LastPattern)+1);
|
|
Result:=true;
|
|
end;
|
|
|
|
function IsFileInIDESrcDir(Filename: string): boolean;
|
|
var
|
|
LazDir: String;
|
|
begin
|
|
Filename:=TrimFilename(Filename);
|
|
if not FilenameIsAbsolute(Filename) then exit(false);
|
|
LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
|
|
Result:=FileIsInPath(Filename,LazDir+'ide')
|
|
or FileIsInPath(Filename,LazDir+'debugger')
|
|
or FileIsInPath(Filename,LazDir+'packager')
|
|
or FileIsInPath(Filename,LazDir+'converter')
|
|
or FileIsInPath(Filename,LazDir+'designer');
|
|
end;
|
|
|
|
procedure RegisterFPCParser;
|
|
begin
|
|
ExternalToolList.RegisterParser(TIDEFPCParser);
|
|
end;
|
|
|
|
{ TPatternToMsgIDs }
|
|
|
|
function TPatternToMsgIDs.IndexOf(Pattern: PChar; Insert: boolean): integer;
|
|
var
|
|
l: Integer;
|
|
r: Integer;
|
|
m: Integer;
|
|
ItemP: PChar;
|
|
FindP: PChar;
|
|
cmp: Integer;
|
|
begin
|
|
Result:=-1;
|
|
l:=0;
|
|
r:=length(fItems)-1;
|
|
cmp:=0;
|
|
m:=0;
|
|
while (l<=r) do begin
|
|
m:=(l+r) div 2;
|
|
ItemP:=PChar(fItems[m].Pattern);
|
|
FindP:=Pattern;
|
|
while (ItemP^=FindP^) do begin
|
|
if ItemP^=#0 then
|
|
exit(m); // exact match
|
|
inc(ItemP);
|
|
inc(FindP);
|
|
end;
|
|
if ItemP^ in [#0,'$'] then begin
|
|
// Pattern longer than Item
|
|
if not Insert then begin
|
|
if (Result<0) or (length(fItems[m].Pattern)>length(fItems[Result].Pattern))
|
|
then
|
|
Result:=m;
|
|
end;
|
|
end;
|
|
cmp:=ord(ItemP^)-ord(FindP^);
|
|
if cmp<0 then
|
|
l:=m+1
|
|
else
|
|
r:=m-1;
|
|
end;
|
|
if Insert then begin
|
|
if cmp<0 then
|
|
Result:=m+1
|
|
else
|
|
Result:=m;
|
|
end;
|
|
end;
|
|
|
|
constructor TPatternToMsgIDs.Create;
|
|
begin
|
|
|
|
end;
|
|
|
|
destructor TPatternToMsgIDs.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPatternToMsgIDs.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to length(fItems)-1 do
|
|
fItems[i].Free;
|
|
SetLength(fItems,0);
|
|
end;
|
|
|
|
procedure TPatternToMsgIDs.Add(Pattern: string; MsgID: integer);
|
|
|
|
procedure RaiseInvalidMsgID;
|
|
begin
|
|
raise Exception.Create('invalid MsgID: '+IntToStr(MsgID));
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Item: TPatternToMsgID;
|
|
Cnt: Integer;
|
|
begin
|
|
if MsgID=0 then
|
|
RaiseInvalidMsgID;
|
|
Pattern:=Trim(Pattern);
|
|
if (Pattern='') or (Pattern[1]='$') then exit;
|
|
i:=IndexOf(PChar(Pattern),true);
|
|
Cnt:=length(fItems);
|
|
SetLength(fItems,Cnt+1);
|
|
if Cnt-i>0 then
|
|
Move(fItems[i],fItems[i+1],SizeOf(TPatternToMsgID)*(Cnt-i));
|
|
Item:=TPatternToMsgID.Create;
|
|
fItems[i]:=Item;
|
|
Item.Pattern:=Pattern;
|
|
Item.MsgID:=MsgID;
|
|
end;
|
|
|
|
procedure TPatternToMsgIDs.AddLines(const Lines: string; MsgID: integer);
|
|
var
|
|
StartPos: PChar;
|
|
p: PChar;
|
|
begin
|
|
p:=PChar(Lines);
|
|
while p^<>#0 do begin
|
|
StartPos:=p;
|
|
while not (p^ in [#0,#10,#13]) do inc(p);
|
|
if p>StartPos then begin
|
|
Add(copy(Lines,StartPos-PChar(Lines)+1,p-StartPos),MsgID);
|
|
end;
|
|
while p^ in [#10,#13] do inc(p);
|
|
end;
|
|
end;
|
|
|
|
function TPatternToMsgIDs.LineToMsgID(p: PChar): integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
while p^ in [' ',#9,#10,#13] do inc(p);
|
|
i:=IndexOf(p,false);
|
|
if i<0 then
|
|
Result:=0
|
|
else
|
|
Result:=fItems[i].MsgID;
|
|
end;
|
|
|
|
procedure TPatternToMsgIDs.WriteDebugReport;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
debugln(['TLineStartToMsgIDs.WriteDebugReport Count=',length(fItems)]);
|
|
for i:=0 to Length(fItems)-1 do begin
|
|
debugln([' ID=',fItems[i].MsgID,'="',fItems[i].Pattern,'"']);
|
|
end;
|
|
ConsistencyCheck;
|
|
end;
|
|
|
|
procedure TPatternToMsgIDs.ConsistencyCheck;
|
|
|
|
procedure E(Msg: string);
|
|
begin
|
|
raise Exception.Create(Msg);
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Item: TPatternToMsgID;
|
|
begin
|
|
for i:=0 to Length(fItems)-1 do begin
|
|
Item:=fItems[i];
|
|
if Item.MsgID<=0 then
|
|
E('Item.MsgID<=0');
|
|
if Item.Pattern='' then
|
|
E('Item.Pattern empty');
|
|
if IndexOf(PChar(Item.Pattern),false)<>i then
|
|
E('IndexOf '+dbgs(i)+' "'+Item.Pattern+'" IndexOf='+dbgs(IndexOf(PChar(Item.Pattern),false)));
|
|
end;
|
|
end;
|
|
|
|
{ TFPCMsgFilePool }
|
|
|
|
procedure TFPCMsgFilePool.Log(Msg: string; AThread: TThread);
|
|
begin
|
|
EnterCriticalsection;
|
|
try
|
|
fPendingLog.Add(Msg);
|
|
finally
|
|
LeaveCriticalSection;
|
|
end;
|
|
if AThread<>nil then
|
|
LogSync
|
|
else
|
|
TThread.Synchronize(AThread,@LogSync);
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.LogSync;
|
|
begin
|
|
EnterCriticalsection;
|
|
try
|
|
dbgout(fPendingLog.Text);
|
|
finally
|
|
LeaveCriticalSection;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.SetDefaultEnglishFile(AValue: string);
|
|
begin
|
|
if FDefaultEnglishFile=AValue then Exit;
|
|
FDefaultEnglishFile:=AValue;
|
|
fMsgFileStamp:=-1;
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.SetDefaultTranslationFile(AValue: string);
|
|
begin
|
|
if FDefaultTranslationFile=AValue then Exit;
|
|
FDefaultTranslationFile:=AValue;
|
|
fMsgFileStamp:=-1;
|
|
end;
|
|
|
|
constructor TFPCMsgFilePool.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
InitCriticalSection(fCritSec);
|
|
FFiles:=TFPList.Create;
|
|
fPendingLog:=TStringList.Create;
|
|
fMsgFileStamp:=-1;
|
|
end;
|
|
|
|
destructor TFPCMsgFilePool.Destroy;
|
|
var
|
|
i: Integer;
|
|
Item: TFPCMsgFilePoolItem;
|
|
begin
|
|
EnterCriticalsection;
|
|
try
|
|
// free unused files
|
|
for i:=FFiles.Count-1 downto 0 do begin
|
|
Item:=TFPCMsgFilePoolItem(FFiles[i]);
|
|
if Item.fUseCount=0 then begin
|
|
Item.Free;
|
|
FFiles.Delete(i);
|
|
end else begin
|
|
debugln(['TFPCMsgFilePool.Destroy file still used: ',Item.Filename]);
|
|
end;
|
|
end;
|
|
if FFiles.Count>0 then
|
|
raise Exception.Create('TFPCMsgFilePool.Destroy some files are still used');
|
|
FreeAndNil(FFiles);
|
|
if FPCMsgFilePool=Self then
|
|
FPCMsgFilePool:=nil;
|
|
inherited Destroy;
|
|
FreeAndNil(fPendingLog);
|
|
finally
|
|
LeaveCriticalSection;
|
|
end;
|
|
DoneCriticalsection(fCritSec);
|
|
end;
|
|
|
|
function TFPCMsgFilePool.LoadCurrentEnglishFile(UpdateFromDisk: boolean;
|
|
AThread: TThread): TFPCMsgFilePoolItem;
|
|
var
|
|
anEnglishFile: string;
|
|
aTranslationFile: string;
|
|
begin
|
|
Result:=nil;
|
|
GetMsgFileNames(EnvironmentOptions.GetParsedCompilerFilename,'','',
|
|
anEnglishFile,aTranslationFile);
|
|
if not FilenameIsAbsolute(anEnglishFile) then exit;
|
|
Result:=LoadFile(anEnglishFile,UpdateFromDisk,AThread);
|
|
end;
|
|
|
|
function TFPCMsgFilePool.LoadFile(aFilename: string; UpdateFromDisk: boolean;
|
|
AThread: TThread): TFPCMsgFilePoolItem;
|
|
var
|
|
IsMainThread: Boolean;
|
|
|
|
procedure ResultOutdated;
|
|
begin
|
|
// cached file needs update
|
|
if Result.fUseCount=0 then begin
|
|
FFiles.Remove(Result);
|
|
Result.Free;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function FileExists: boolean;
|
|
begin
|
|
if IsMainThread then
|
|
Result:=FileExistsCached(aFilename)
|
|
else
|
|
Result:=FileExistsUTF8(aFilename);
|
|
end;
|
|
|
|
function FileAge: longint;
|
|
begin
|
|
if IsMainThread then
|
|
Result:=FileAgeCached(aFilename)
|
|
else
|
|
Result:=FileAgeUTF8(aFilename);
|
|
end;
|
|
|
|
var
|
|
Item: TFPCMsgFilePoolItem;
|
|
i: Integer;
|
|
NewItem: TFPCMsgFilePoolItem;
|
|
FileTxt: string;
|
|
ms: TMemoryStream;
|
|
Encoding: String;
|
|
begin
|
|
Result:=nil;
|
|
if aFilename='' then exit;
|
|
aFilename:=TrimAndExpandFilename(aFilename);
|
|
//Log('TFPCMsgFilePool.LoadFile '+aFilename,aThread);
|
|
|
|
IsMainThread:=GetThreadID=MainThreadID;
|
|
if UpdateFromDisk then begin
|
|
if not FileExists then begin
|
|
Log('TFPCMsgFilePool.LoadFile file not found: '+aFilename,AThread);
|
|
exit;
|
|
end;
|
|
end;
|
|
NewItem:=nil;
|
|
ms:=nil;
|
|
EnterCriticalsection;
|
|
try
|
|
// search the newest version in cache
|
|
for i:=FFiles.Count-1 downto 0 do begin
|
|
Item:=TFPCMsgFilePoolItem(FFiles[i]);
|
|
if CompareFilenames(Item.Filename,aFilename)<>0 then continue;
|
|
Result:=Item;
|
|
break;
|
|
end;
|
|
if UpdateFromDisk then begin
|
|
if (Result<>nil)
|
|
and (FileAge<>Result.LoadedFileAge) then
|
|
ResultOutdated;
|
|
end else if Result=nil then begin
|
|
// not yet loaded, not yet checked if file exists -> check now
|
|
if not FileExists then
|
|
exit;
|
|
end;
|
|
|
|
if Result<>nil then begin
|
|
// share
|
|
inc(Result.fUseCount);
|
|
end else begin
|
|
// load for the first time
|
|
NewItem:=TFPCMsgFilePoolItem.Create(Self,aFilename);
|
|
//Log('TFPCMsgFilePool.LoadFile '+dbgs(NewItem.FMsgFile<>nil)+' '+aFilename,aThread);
|
|
if Assigned(OnLoadFile) then begin
|
|
OnLoadFile(aFilename,FileTxt);
|
|
end else begin
|
|
ms:=TMemoryStream.Create;
|
|
ms.LoadFromFile(aFilename);
|
|
SetLength(FileTxt,ms.Size);
|
|
ms.Position:=0;
|
|
if FileTxt<>'' then
|
|
ms.Read(FileTxt[1],length(FileTxt));
|
|
end;
|
|
// convert encoding
|
|
Encoding:=GetDefaultFPCErrorMsgFileEncoding(aFilename);
|
|
FileTxt:=ConvertEncoding(FileTxt,Encoding,EncodingUTF8);
|
|
// parse
|
|
NewItem.FMsgFile.LoadFromText(FileTxt);
|
|
NewItem.FLoadedFileAge:=FileAge;
|
|
// load successful
|
|
Result:=NewItem;
|
|
NewItem:=nil;
|
|
FFiles.Add(Result);
|
|
inc(Result.fUseCount);
|
|
//log('TFPCMsgFilePool.LoadFile '+Result.Filename+' '+dbgs(Result.fUseCount),aThread);
|
|
end;
|
|
finally
|
|
ms.Free;
|
|
FreeAndNil(NewItem);
|
|
LeaveCriticalSection;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.UnloadFile(var aFile: TFPCMsgFilePoolItem);
|
|
var
|
|
i: Integer;
|
|
Item: TFPCMsgFilePoolItem;
|
|
Keep: Boolean;
|
|
begin
|
|
EnterCriticalsection;
|
|
try
|
|
if aFile.fUseCount<=0 then
|
|
raise Exception.Create('TFPCMsgFilePool.UnloadFile already freed');
|
|
if FFiles.IndexOf(aFile)<0 then
|
|
raise Exception.Create('TFPCMsgFilePool.UnloadFile unknown, maybe already freed');
|
|
dec(aFile.fUseCount);
|
|
//log('TFPCMsgFilePool.UnloadFile '+aFile.Filename+' UseCount='+dbgs(aFile.fUseCount),aThread);
|
|
if aFile.fUseCount>0 then exit;
|
|
// not used anymore
|
|
if not FileExistsUTF8(aFile.Filename) then begin
|
|
Keep:=false;
|
|
end else begin
|
|
// file still exist on disk
|
|
// => check if it is the newest version
|
|
Keep:=true;
|
|
for i:=FFiles.Count-1 downto 0 do begin
|
|
Item:=TFPCMsgFilePoolItem(FFiles[i]);
|
|
if Item=aFile then break;
|
|
if CompareFilenames(Item.Filename,aFile.Filename)<>0 then continue;
|
|
// there is already a newer version
|
|
Keep:=false;
|
|
break;
|
|
end;
|
|
end;
|
|
if Keep then begin
|
|
// this file is the newest version => keep it in cache
|
|
end else begin
|
|
//log('TFPCMsgFilePool.UnloadFile free: '+aFile.Filename,aThread);
|
|
FFiles.Remove(aFile);
|
|
aFile.Free;
|
|
end;
|
|
finally
|
|
aFile:=nil;
|
|
LeaveCriticalSection;
|
|
end;
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.EnterCriticalsection;
|
|
begin
|
|
System.EnterCriticalsection(fCritSec);
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.LeaveCriticalSection;
|
|
begin
|
|
System.LeaveCriticalsection(fCritSec);
|
|
end;
|
|
|
|
procedure TFPCMsgFilePool.GetMsgFileNames(CompilerFilename, TargetOS,
|
|
TargetCPU: string; out anEnglishFile, aTranslationFile: string);
|
|
var
|
|
FPCVer: String;
|
|
FPCSrcDir: String;
|
|
aFilename: String;
|
|
ErrMsg: string;
|
|
begin
|
|
if fMsgFileStamp<>CompilerParseStamp then begin
|
|
fCurrentEnglishFile:=DefaultEnglishFile;
|
|
fCurrentTranslationFile:=DefaulTranslationFile;
|
|
// English msg file
|
|
// => use fpcsrcdir/compiler/msg/errore.msg
|
|
// the fpcsrcdir might depend on the FPC version
|
|
if IsFPCExecutable(CompilerFilename,ErrMsg) then
|
|
FPCVer:=CodeToolBoss.FPCDefinesCache.GetFPCVersion(CompilerFilename,TargetOS,TargetCPU,false)
|
|
else
|
|
FPCVer:='';
|
|
FPCSrcDir:=EnvironmentOptions.GetParsedFPCSourceDirectory(FPCVer);
|
|
if FilenameIsAbsolute(FPCSrcDir) then begin
|
|
// FPCSrcDir exists => use the errore.msg
|
|
aFilename:=AppendPathDelim(FPCSrcDir)+SetDirSeparators('compiler/msg/errore.msg');
|
|
if FileExistsCached(aFilename) then
|
|
fCurrentEnglishFile:=aFilename;
|
|
end;
|
|
if not FileExistsCached(fCurrentEnglishFile) then begin
|
|
// as fallback use the copy in the Codetools directory
|
|
aFilename:=EnvironmentOptions.GetParsedLazarusDirectory;
|
|
if FilenameIsAbsolute(aFilename) then begin
|
|
aFilename:=AppendPathDelim(aFilename)+SetDirSeparators('components/codetools/fpc.errore.msg');
|
|
if FileExistsCached(aFilename) then
|
|
fCurrentEnglishFile:=aFilename;
|
|
end;
|
|
end;
|
|
// translation msg file
|
|
aFilename:=EnvironmentOptions.GetParsedCompilerMessagesFilename;
|
|
if FilenameIsAbsolute(aFilename) and FileExistsCached(aFilename)
|
|
and (CompareFilenames(aFilename,fCurrentEnglishFile)<>0) then
|
|
fCurrentTranslationFile:=aFilename;
|
|
fMsgFileStamp:=CompilerParseStamp;
|
|
end;
|
|
anEnglishFile:=fCurrentEnglishFile;
|
|
aTranslationFile:=fCurrentTranslationFile;
|
|
end;
|
|
|
|
{ TFPCMsgFilePoolItem }
|
|
|
|
constructor TFPCMsgFilePoolItem.Create(aPool: TFPCMsgFilePool;
|
|
const aFilename: string);
|
|
begin
|
|
inherited Create;
|
|
FPool:=aPool;
|
|
FFilename:=aFilename;
|
|
FMsgFile:=TFPCMsgFile.Create;
|
|
end;
|
|
|
|
destructor TFPCMsgFilePoolItem.Destroy;
|
|
begin
|
|
FreeAndNil(FMsgFile);
|
|
FFilename:='';
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TFPCMsgFilePoolItem.GetMsg(ID: integer): TFPCMsgItem;
|
|
begin
|
|
Result:=FMsgFile.FindWithID(ID);
|
|
end;
|
|
|
|
{ TIDEFPCParser }
|
|
|
|
destructor TIDEFPCParser.Destroy;
|
|
begin
|
|
FreeAndNil(FFilesToIgnoreUnitNotUsed);
|
|
FreeAndNil(fFileExists);
|
|
FreeAndNil(fCurSource);
|
|
if TranslationFile<>nil then
|
|
FPCMsgFilePool.UnloadFile(TranslationFile);
|
|
if MsgFile<>nil then
|
|
FPCMsgFilePool.UnloadFile(MsgFile);
|
|
FreeAndNil(DirectoryStack);
|
|
FreeAndNil(fLineToMsgID);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.Init;
|
|
|
|
procedure LoadMsgFile(aFilename: string; var List: TFPCMsgFilePoolItem);
|
|
begin
|
|
//debugln(['TFPCParser.Init load Msg filename=',aFilename]);
|
|
if aFilename='' then
|
|
debugln(['WARNING: TFPCParser.Init missing msg file'])
|
|
else if (aFilename<>'') and (List=nil) then begin
|
|
try
|
|
List:=FPCMsgFilePool.LoadFile(aFilename,true,nil);
|
|
{$IFDEF VerboseExtToolThread}
|
|
debugln(['LoadMsgFile successfully read ',aFilename]);
|
|
{$ENDIF}
|
|
except
|
|
on E: Exception do begin
|
|
debugln(['WARNING: TFPCParser.Init failed to load file '+aFilename+': '+E.Message]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
Param: String;
|
|
p: PChar;
|
|
aTargetOS: String;
|
|
aTargetCPU: String;
|
|
begin
|
|
inherited Init;
|
|
|
|
if FPCMsgFilePool<>nil then begin
|
|
aTargetOS:='';
|
|
aTargetCPU:='';
|
|
for i:=0 to Tool.Process.Parameters.Count-1 do begin
|
|
Param:=Tool.Process.Parameters[i];
|
|
if Param='' then continue;
|
|
p:=PChar(Param);
|
|
if p^<>'-' then continue;
|
|
if p[1]='T' then
|
|
aTargetOS:=copy(Param,3,255)
|
|
else if p[1]='P' then
|
|
aTargetCPU:=copy(Param,3,255);
|
|
end;
|
|
FPCMsgFilePool.GetMsgFileNames(Tool.Process.Executable,aTargetOS,aTargetCPU,
|
|
MsgFilename,TranslationFilename);
|
|
end;
|
|
|
|
LoadMsgFile(MsgFilename,MsgFile);
|
|
if TranslationFilename<>'' then
|
|
LoadMsgFile(TranslationFilename,TranslationFile);
|
|
|
|
// get include search path
|
|
fIncludePathValidForWorkerDir:=Tool.WorkerDirectory;
|
|
fIncludePath:=CodeToolBoss.GetIncludePathForDirectory(
|
|
ChompPathDelim(fIncludePathValidForWorkerDir));
|
|
// get include search path
|
|
fUnitPathValidForWorkerDir:=Tool.WorkerDirectory;
|
|
fUnitPath:=CodeToolBoss.GetUnitPathForDirectory(
|
|
ChompPathDelim(fUnitPathValidForWorkerDir));
|
|
end;
|
|
|
|
procedure TIDEFPCParser.InitReading;
|
|
|
|
procedure AddPatternItem(MsgID: integer);
|
|
var
|
|
Item: TFPCMsgItem;
|
|
begin
|
|
Item:=MsgFile.GetMsg(MsgID);
|
|
if Item<>nil then
|
|
fLineToMsgID.AddLines(Item.Pattern,Item.ID);
|
|
end;
|
|
|
|
var
|
|
p: TExtToolParserSyncPhase;
|
|
begin
|
|
inherited InitReading;
|
|
|
|
fLineToMsgID.Clear;
|
|
AddPatternItem(FPCMsgIDLogo);
|
|
AddPatternItem(FPCMsgIDLinking);
|
|
AddPatternItem(FPCMsgIDCallingResourceCompiler);
|
|
//fLineToMsgID.WriteDebugReport;
|
|
|
|
for p:=low(fLastWorkerImprovedMessage) to high(fLastWorkerImprovedMessage) do
|
|
fLastWorkerImprovedMessage[p]:=-1;
|
|
|
|
FreeAndNil(DirectoryStack);
|
|
end;
|
|
|
|
procedure TIDEFPCParser.Done;
|
|
begin
|
|
FreeAndNil(fCurSource);
|
|
inherited Done;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForCompilingState(p: PChar): boolean;
|
|
const
|
|
FPCMsgIDCompiling = 3104;
|
|
var
|
|
AFilename: string;
|
|
MsgLine: TMessageLine;
|
|
OldP: PChar;
|
|
begin
|
|
OldP:=p;
|
|
// for example 'Compiling ./subdir/unit1.pas'
|
|
if fMsgID=0 then begin
|
|
if not ReadString(p,'Compiling ') then exit(false);
|
|
fMsgID:=FPCMsgIDCompiling;
|
|
Result:=true;
|
|
end else if fMsgID=FPCMsgIDCompiling then begin
|
|
Result:=true;
|
|
if not ReadString(p,'Compiling ') then exit;
|
|
end else begin
|
|
exit(false);
|
|
end;
|
|
// add path to history
|
|
if (p^='.') and (p[1]=PathDelim) then
|
|
inc(p,2); // skip ./
|
|
AFilename:=ExtractFilePath(TrimFilename(p));
|
|
if AFilename<>'' then begin
|
|
if (not FilenameIsAbsolute(AFilename)) and (Tool.WorkerDirectory<>'') then
|
|
AFilename:=TrimFilename(AppendPathDelim(Tool.WorkerDirectory)+AFilename);
|
|
if DirectoryStack=nil then DirectoryStack:=TStringList.Create;
|
|
if (DirectoryStack.Count=0)
|
|
or (DirectoryStack[DirectoryStack.Count-1]<>AFilename) then
|
|
DirectoryStack.Add(AFilename);
|
|
end;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Filename:=AFilename;
|
|
MsgLine.Msg:=OldP;
|
|
AddMsgLine(MsgLine);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForAssemblingState(p: PChar): boolean;
|
|
var
|
|
MsgLine: TMessageLine;
|
|
OldP: PChar;
|
|
begin
|
|
Result:=fMsgID=9001;
|
|
if (fMsgID>0) and not Result then exit;
|
|
OldP:=p;
|
|
if (not Result) and (not CompStr('Assembling ',p)) then exit;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.Msg:=OldP;
|
|
AddMsgLine(MsgLine);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForGeneralMessage(p: PChar): boolean;
|
|
{ check for
|
|
Fatal: message
|
|
Hint: (11030) Start of reading config file /etc/fpc.cfg
|
|
Error: /usr/bin/ppc386 returned an error exitcode
|
|
}
|
|
const
|
|
FPCMsgIDCompilationAborted = 1018;
|
|
FrontEndFPCExitCodeError = 'returned an error exitcode';
|
|
var
|
|
MsgLine: TMessageLine;
|
|
MsgType: TMessageLineUrgency;
|
|
p2: PChar;
|
|
i: Integer;
|
|
TranslatedItem: TFPCMsgItem;
|
|
MsgItem: TFPCMsgItem;
|
|
TranslatedMsg: String;
|
|
|
|
procedure CheckFinalNote;
|
|
// check if there was already an error message
|
|
// if yes, then downgrade this message to a mluVerbose
|
|
var
|
|
u: TMessageLineUrgency;
|
|
begin
|
|
for u:=mluError to high(TMessageLineUrgency) do
|
|
if Tool.WorkerMessages.UrgencyCounts[u]>0 then
|
|
begin
|
|
MsgType:=mluVerbose;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
MsgType:=mluNone;
|
|
if ReadString(p,'Fatal: ') then begin
|
|
MsgType:=mluFatal;
|
|
// check for "Fatal: compilation aborted"
|
|
if fMsgItemCompilationAborted=nil then begin
|
|
fMsgItemCompilationAborted:=MsgFile.GetMsg(FPCMsgIDCompilationAborted);
|
|
if fMsgItemCompilationAborted=nil then
|
|
fMsgItemCompilationAborted:=fMissingFPCMsgItem;
|
|
end;
|
|
p2:=p;
|
|
if (fMsgItemCompilationAborted<>fMissingFPCMsgItem)
|
|
and ReadString(p2,fMsgItemCompilationAborted.Pattern) then
|
|
CheckFinalNote;
|
|
end
|
|
else if ReadString(p,'Panic') then
|
|
MsgType:=mluPanic
|
|
else if ReadString(p,'Error: ') then begin
|
|
// check for fpc frontend message "Error: /usr/bin/ppc386 returned an error exitcode"
|
|
TranslatedMsg:=p;
|
|
MsgType:=mluError;
|
|
if Pos(FrontEndFPCExitCodeError,TranslatedMsg)>0 then begin
|
|
fMsgID:=FPCMsgIDCompilationAborted;
|
|
CheckFinalNote;
|
|
end;
|
|
end
|
|
else if ReadString(p,'Warn: ') then
|
|
MsgType:=mluWarning
|
|
else if ReadString(p,'Note: ') then
|
|
MsgType:=mluNote
|
|
else if ReadString(p,'Hint: ') then
|
|
MsgType:=mluHint
|
|
else if ReadString(p,'Debug: ') then
|
|
MsgType:=mluDebug
|
|
else begin
|
|
exit;
|
|
end;
|
|
if MsgType=mluNone then exit;
|
|
|
|
Result:=true;
|
|
while p^ in [' ',#9] do inc(p);
|
|
TranslatedMsg:='';
|
|
if (p^='(') and (p[1] in ['0'..'9']) then begin
|
|
p2:=p;
|
|
inc(p2);
|
|
i:=0;
|
|
while (p2^ in ['0'..'9']) and (i<1000000) do begin
|
|
i:=i*10+ord(p2^)-ord('0');
|
|
inc(p2);
|
|
end;
|
|
if p2^=')' then begin
|
|
fMsgID:=i;
|
|
p:=p2+1;
|
|
while p^ in [' ',#9] do inc(p);
|
|
//if Pos('reading',String(p))>0 then
|
|
// debugln(['TFPCParser.CheckForGeneralMessage ID=',fMsgID,' Msg=',p]);
|
|
if (fMsgID>0) then begin
|
|
TranslatedItem:=nil;
|
|
MsgItem:=nil;
|
|
if (MsgFile<>nil) then
|
|
MsgItem:=MsgFile.GetMsg(fMsgID);
|
|
if (TranslationFile<>nil) then
|
|
TranslatedItem:=TranslationFile.GetMsg(fMsgID);
|
|
Translate(p,MsgItem,TranslatedItem,TranslatedMsg,MsgType);
|
|
if (TranslatedItem=nil) and (MsgItem=nil) then begin
|
|
if ConsoleVerbosity>=0 then
|
|
debugln(['TFPCParser.CheckForGeneralMessage msgid not found: ',fMsgID]);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
if (MsgType>=mluError) and (fMsgID=FPCMsgIDCompilationAborted) // fatal: Compilation aborted
|
|
then begin
|
|
CheckFinalNote;
|
|
end;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.Urgency:=MsgType;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Msg:=p;
|
|
MsgLine.TranslatedMsg:=TranslatedMsg;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForLineProgress(p: PChar): boolean;
|
|
// for example: 600 206.521/231.648 Kb Used
|
|
var
|
|
OldP: PChar;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
Result:=false;
|
|
OldP:=p;
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
if not ReadChar(p,' ') then exit;
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
if not ReadChar(p,'/') then exit;
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
if not ReadChar(p,' ') then exit;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.Msg:=OldP;
|
|
AddMsgLine(MsgLine);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForLinesCompiled(p: PChar): boolean;
|
|
var
|
|
OldStart: PChar;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
Result:=fMsgID=1008;
|
|
if (fMsgID>0) and not Result then exit;
|
|
OldStart:=p;
|
|
if not Result then begin
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
if not ReadString(p,' lines compiled, ') then exit;
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
end;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.Msg:=OldStart;
|
|
AddMsgLine(MsgLine);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForExecutableInfo(p: PChar): boolean;
|
|
{ For example:
|
|
Size of Code: 1184256 bytes
|
|
Size of initialized data: 519168 bytes
|
|
Size of uninitialized data: 83968 bytes
|
|
Stack space reserved: 262144 bytes
|
|
Stack space commited: 4096 bytes
|
|
}
|
|
var
|
|
OldStart: PChar;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
Result:=(fMsgID>=9130) and (fMsgID<=9140);
|
|
if (fMsgID>0) and not Result then exit;
|
|
OldStart:=p;
|
|
if (not Result) then begin
|
|
if not (ReadString(p,'Size of Code: ') or
|
|
ReadString(p,'Size of initialized data: ') or
|
|
ReadString(p,'Size of uninitialized data: ') or
|
|
ReadString(p,'Stack space reserved: ') or
|
|
ReadString(p,'Stack space commited: ') or // message contains typo
|
|
ReadString(p,'Stack space committed: ')) then exit;
|
|
if not ReadNumberWithThousandSep(p) then exit;
|
|
if not ReadString(p,' bytes') then exit;
|
|
end;
|
|
Result:=true;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.Msg:=OldStart;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForWindresErrors(p: PChar): boolean;
|
|
// example: ...\windres.exe: warning: ...
|
|
var
|
|
MsgLine: TMessageLine;
|
|
WPos: PChar;
|
|
begin
|
|
Result := false;
|
|
WPos:=FindSubStrI('windres',p);
|
|
if WPos=nil then exit;
|
|
Result:=true;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPCWindRes;
|
|
MsgLine.Urgency:=mluWarning;
|
|
p := wPos + 7;
|
|
if CompStr('.exe', p) then
|
|
inc(p, 4);
|
|
MsgLine.Msg:='windres' + p;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForInfos(p: PChar): boolean;
|
|
var
|
|
MsgItem: TFPCMsgItem;
|
|
MsgLine: TMessageLine;
|
|
i: Integer;
|
|
MsgType: TMessageLineUrgency;
|
|
begin
|
|
Result:=false;
|
|
i:=fLineToMsgID.LineToMsgID(p);
|
|
if i=0 then exit;
|
|
fMsgID:=i;
|
|
if (fMsgID=FPCMsgIDLogo) and (DirectoryStack<>nil) then begin
|
|
// a new call of the compiler (e.g. when compiling via make)
|
|
// => clear stack
|
|
FreeAndNil(DirectoryStack);
|
|
end;
|
|
MsgItem:=MsgFile.GetMsg(fMsgID);
|
|
if MsgItem=nil then exit;
|
|
Result:=true;
|
|
MsgType:=FPCMsgToMsgUrgency(MsgItem);
|
|
if MsgType=mluNone then
|
|
MsgType:=mluVerbose;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=MsgType;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CreateMsgLine: TMessageLine;
|
|
begin
|
|
Result:=inherited CreateMsgLine(fOutputIndex);
|
|
Result.MsgID:=fMsgID;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.AddLinkingMessages;
|
|
{ Add messages for all output between "Linking ..." and the
|
|
current line "Error while linking"
|
|
|
|
For example:
|
|
Linking /home/user/project1
|
|
/usr/bin/ld: warning: /home/user/link.res contains output sections; did you forget -T?
|
|
/usr/bin/ld: cannot find -la52
|
|
project1.lpr(20,1) Error: Error while linking
|
|
|
|
Examples for linking errors:
|
|
linkerror.o(.text$_main+0x9):linkerror.pas: undefined reference to `NonExistingFunction'
|
|
|
|
/path/lib/x86_64-linux/blaunit.o: In function `FORMCREATE':
|
|
/path//blaunit.pas:45: undefined reference to `BLAUNIT_BLABLA'
|
|
|
|
Closing script ppas.sh
|
|
|
|
Mac OS X linker example:
|
|
ld: framework not found Cocoas
|
|
|
|
Multiline Mac OS X linker example:
|
|
Undefined symbols:
|
|
"_exterfunc", referenced from:
|
|
_PASCALMAIN in testld.o
|
|
"_exterfunc2", referenced from:
|
|
_PASCALMAIN in testld.o
|
|
ld: symbol(s) not found
|
|
|
|
Linking project1
|
|
Undefined symbols for architecture x86_64:
|
|
"_GetCurrentEventButtonState", referenced from:
|
|
_COCOAINT_TCOCOAWIDGETSET_$__GETKEYSTATE$LONGINT$$SMALLINT in cocoaint.o
|
|
ld: symbol(s) not found for architecture x86_64
|
|
An error occurred while linking
|
|
}
|
|
var
|
|
i: Integer;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
// find message "Linking ..."
|
|
i:=Tool.WorkerMessages.Count-1;
|
|
while (i>=0) and (Tool.WorkerMessages[i].MsgID<>FPCMsgIDLinking) do
|
|
dec(i);
|
|
if i<0 then exit;
|
|
MsgLine:=Tool.WorkerMessages[i];
|
|
for i:=MsgLine.OutputIndex+1 to fOutputIndex-1 do begin
|
|
MsgLine:=inherited CreateMsgLine(i);
|
|
MsgLine.MsgID:=0;
|
|
MsgLine.SubTool:=SubToolFPCLinker;
|
|
MsgLine.Urgency:=mluImportant;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.AddResourceMessages;
|
|
{ Add messages for all output between "Calling resource compiler " and the
|
|
current line "Error while compiling resources"
|
|
|
|
For example:
|
|
Calling resource compiler "/usr/bin/fpcres" with "-o /home/user/project1.or -a x86_64 -of elf -v "@/home/user/project1.reslst"" as command line
|
|
Debug: parsing command line parameters
|
|
...
|
|
Error: Error while compiling resources
|
|
}
|
|
var
|
|
i: Integer;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
// find message "Linking ..."
|
|
i:=Tool.WorkerMessages.Count-1;
|
|
while (i>=0) and (Tool.WorkerMessages[i].MsgID<>FPCMsgIDCallingResourceCompiler) do
|
|
dec(i);
|
|
if i<0 then exit;
|
|
MsgLine:=Tool.WorkerMessages[i];
|
|
for i:=MsgLine.OutputIndex+1 to fOutputIndex-1 do begin
|
|
MsgLine:=inherited CreateMsgLine(i);
|
|
MsgLine.MsgID:=0;
|
|
MsgLine.SubTool:=SubToolFPCRes;
|
|
MsgLine.Urgency:=mluHint;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
end;
|
|
|
|
function TIDEFPCParser.NeedSource(aPhase: TExtToolParserSyncPhase;
|
|
SourceOk: boolean): boolean;
|
|
begin
|
|
if SourceOk then exit(false);
|
|
case aPhase of
|
|
etpspAfterReadLine: NeedSynchronize:=true;
|
|
etpspSynchronized: NeedAfterSync:=true;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.IsMsgID(MsgLine: TMessageLine; MsgID: integer;
|
|
var Item: TFPCMsgItem): boolean;
|
|
begin
|
|
if MsgLine.MsgID=MsgID then exit(true);
|
|
Result:=false;
|
|
if MsgLine.MsgID<>0 then exit;
|
|
if MsgLine.SubTool<>SubToolFPC then exit;
|
|
if Item=nil then begin
|
|
Item:=MsgFile.GetMsg(MsgID);
|
|
if Item=nil then
|
|
Item:=fMissingFPCMsgItem;
|
|
end;
|
|
if Item=fMissingFPCMsgItem then exit;
|
|
if Item.PatternFits(MsgLine.Msg)<0 then exit;
|
|
MsgLine.MsgID:=MsgID;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgHiddenByIDEDirective(
|
|
aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine; SourceOK: Boolean);
|
|
// check for {%H-}
|
|
var
|
|
p: PChar;
|
|
X: Integer;
|
|
Y: Integer;
|
|
begin
|
|
if MsgLine.Urgency>=mluError then exit;
|
|
if mlfHiddenByIDEDirectiveValid in MsgLine.Flags then exit;
|
|
if NeedSource(aPhase,SourceOK) then
|
|
exit;
|
|
|
|
X:=MsgLine.Column;
|
|
Y:=MsgLine.Line;
|
|
if (y<=fCurSource.LineCount) and (x-1<=fCurSource.GetLineLength(y-1))
|
|
then begin
|
|
p:=PChar(fCurSource.Source)+fCurSource.GetLineStart(y-1)+x-2;
|
|
//debugln(['TFPCParser.ImproveMsgHiddenByIDEDirective ',aFilename,' ',Y,',',X,' ',copy(fCurSource.GetLine(y-1),1,x-1),'|',copy(fCurSource.GetLine(y-1),x,100),' p=',p[0],p[1],p[2]]);
|
|
if ((p^='{') and (p[1]='%') and (p[2]='H') and (p[3]='-'))
|
|
or ((x>5) and (p[-5]='{') and (p[-4]='%') and (p[-3]='H') and (p[-2]='-')
|
|
and (p[-1]='}'))
|
|
then begin
|
|
//debugln(['TFPCParser.ImproveMsgHiddenByIDEDirective HIDDEN ',aFilename,' ',Y,',',X,' ',MsgLine.Msg]);
|
|
MsgLine.Flags:=MsgLine.Flags+[mlfHiddenByIDEDirective,
|
|
mlfHiddenByIDEDirectiveValid];
|
|
end;
|
|
end;
|
|
MsgLine.Flags:=MsgLine.Flags+[mlfHiddenByIDEDirectiveValid];
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgSenderNotUsed(
|
|
aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine);
|
|
// FPCMsgIDParameterNotUsed = 5024; Parameter "$1" not used
|
|
begin
|
|
if aPhase<>etpspAfterReadLine then exit;
|
|
if (MsgLine.Urgency<=mluVerbose) then exit;
|
|
// check for Sender not used
|
|
if HideHintsSenderNotUsed
|
|
and (MsgLine.Msg='Parameter "Sender" not used') then begin
|
|
MsgLine.Urgency:=mluVerbose;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgUnitNotUsed(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine);
|
|
// check for Unit not used message in main sources
|
|
// and change urgency to merely 'verbose'
|
|
const
|
|
FPCMsgIDUnitNotUsed = 5023; // Unit "$1" not used in $2
|
|
begin
|
|
if aPhase<>etpspAfterReadLine then exit;
|
|
if (MsgLine.Urgency<=mluVerbose) then exit;
|
|
if not IsMsgID(MsgLine,FPCMsgIDUnitNotUsed,fMsgItemUnitNotUsed) then exit;
|
|
|
|
//debugln(['TIDEFPCParser.ImproveMsgUnitNotUsed ',aPhase=etpspSynchronized,' ',MsgLine.Msg]);
|
|
// unit not used
|
|
if IndexInStringList(FilesToIgnoreUnitNotUsed,cstFilename,MsgLine.Filename)>=0 then
|
|
begin
|
|
MsgLine.Urgency:=mluVerbose;
|
|
end else if HideHintsUnitNotUsedInMainSource
|
|
and FilenameIsAbsolute(MsgLine.Filename)
|
|
and ((CompareFileExt(MsgLine.Filename, 'lpr', false)=0)
|
|
or FileExists(ChangeFileExt(MsgLine.Filename, '.lpk'), aPhase=etpspSynchronized))
|
|
then begin
|
|
// a lpk/lpr does not use a unit => almost always not important
|
|
MsgLine.Urgency:=mluVerbose;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgUnitNotFound(aPhase: TExtToolParserSyncPhase;
|
|
MsgLine: TMessageLine);
|
|
|
|
procedure FixSourcePos(CodeBuf: TCodeBuffer; MissingUnitname: string);
|
|
var
|
|
InPos: Integer;
|
|
NamePos: Integer;
|
|
Tool: TCodeTool;
|
|
Caret: TCodeXYPosition;
|
|
NewFilename: String;
|
|
begin
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound File=',CodeBuf.Filename]);
|
|
{$ENDIF}
|
|
LazarusIDE.SaveSourceEditorChangesToCodeCache(nil);
|
|
if not CodeToolBoss.FindUnitInAllUsesSections(CodeBuf,MissingUnitname,NamePos,InPos)
|
|
then begin
|
|
DebugLn('TIDEFPCParser.ImproveMsgUnitNotFound FindUnitInAllUsesSections failed due to syntax errors or '+MissingUnitname+' is not used in '+CodeBuf.Filename);
|
|
exit;
|
|
end;
|
|
Tool:=CodeToolBoss.CurCodeTool;
|
|
if Tool=nil then exit;
|
|
if not Tool.CleanPosToCaret(NamePos,Caret) then exit;
|
|
if (Caret.X>0) and (Caret.Y>0) then begin
|
|
//DebugLn('QuickFixUnitNotFoundPosition Line=',dbgs(Line),' Col=',dbgs(Col));
|
|
NewFilename:=Caret.Code.Filename;
|
|
MsgLine.SetSourcePosition(NewFilename,Caret.Y,Caret.X);
|
|
end;
|
|
end;
|
|
|
|
procedure FindPPUFiles(MissingUnitname: string; PkgList: TFPList;
|
|
PPUFiles: TStringList // Strings:PPUFilename, Objects:TIDEPackage
|
|
);
|
|
var
|
|
i: Integer;
|
|
Pkg: TIDEPackage;
|
|
DirCache: TCTDirectoryCache;
|
|
PPUFilename: String;
|
|
UnitOutDir: String;
|
|
begin
|
|
if PkgList=nil then exit;
|
|
for i:=0 to PkgList.Count-1 do begin
|
|
Pkg:=TIDEPackage(PkgList[i]);
|
|
UnitOutDir:=Pkg.LazCompilerOptions.GetUnitOutputDirectory(false);
|
|
//debugln(['TQuickFixUnitNotFoundPosition.Execute ',Pkg.Name,' UnitOutDir=',UnitOutDir]);
|
|
if not FilenameIsAbsolute(UnitOutDir) then continue;
|
|
DirCache:=CodeToolBoss.DirectoryCachePool.GetCache(UnitOutDir,true,false);
|
|
PPUFilename:=DirCache.FindFile(MissingUnitname+'.ppu',ctsfcLoUpCase);
|
|
//debugln(['TQuickFixUnitNotFoundPosition.Execute ShortPPU=',PPUFilename]);
|
|
if PPUFilename='' then continue;
|
|
PPUFilename:=AppendPathDelim(DirCache.Directory)+PPUFilename;
|
|
PPUFiles.AddObject(PPUFilename,Pkg);
|
|
end;
|
|
end;
|
|
|
|
procedure FindPPUInInstalledPkgs(MissingUnitname: string;
|
|
PPUFiles: TStringList // Strings:PPUFilename, Objects:TIDEPackage
|
|
);
|
|
var
|
|
i: Integer;
|
|
Pkg: TIDEPackage;
|
|
PkgList: TFPList;
|
|
begin
|
|
// search ppu in installed packages
|
|
PkgList:=TFPList.Create;
|
|
try
|
|
for i:=0 to PackageEditingInterface.GetPackageCount-1 do begin
|
|
Pkg:=PackageEditingInterface.GetPackages(i);
|
|
if Pkg.AutoInstall=pitNope then continue;
|
|
PkgList.Add(Pkg);
|
|
end;
|
|
FindPPUFiles(MissingUnitname,PkgList,PPUFiles);
|
|
finally
|
|
PkgList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure FindPPUInModuleAndDeps(MissingUnitname: string; Module: TObject;
|
|
PPUFiles: TStringList // Strings:PPUFilename, Objects:TIDEPackage
|
|
);
|
|
var
|
|
PkgList: TFPList;
|
|
begin
|
|
PkgList:=nil;
|
|
try
|
|
PackageEditingInterface.GetRequiredPackages(Module,PkgList);
|
|
if (Module is TIDEPackage) then begin
|
|
if PkgList=nil then
|
|
PkgList:=TFPList.Create;
|
|
if PkgList.IndexOf(Module)<0 then
|
|
PkgList.Add(Module);
|
|
end;
|
|
FindPPUFiles(MissingUnitname,PkgList,PPUFiles);
|
|
finally
|
|
PkgList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure FindPackage(MissingUnitname: string; out PkgName: string;
|
|
OnlyInstalled: boolean; out PkgFile: TLazPackageFile);
|
|
var
|
|
i: Integer;
|
|
Pkg: TIDEPackage;
|
|
j: Integer;
|
|
aFile: TLazPackageFile;
|
|
begin
|
|
PkgName:='';
|
|
PkgFile:=nil;
|
|
// search unit in packages
|
|
for i:=0 to PackageEditingInterface.GetPackageCount-1 do begin
|
|
Pkg:=PackageEditingInterface.GetPackages(i);
|
|
if OnlyInstalled and (Pkg.AutoInstall=pitNope) then
|
|
continue;
|
|
if CompareTextCT(Pkg.Name,MissingUnitname)=0 then begin
|
|
PkgName:=Pkg.Name;
|
|
break;
|
|
end;
|
|
for j:=0 to Pkg.FileCount-1 do begin
|
|
aFile:=Pkg.Files[j];
|
|
if not (aFile.FileType in PkgFileRealUnitTypes) then
|
|
continue;
|
|
if CompareTextCT(ExtractFileNameOnly(aFile.Filename),MissingUnitname)<>0
|
|
then continue;
|
|
if (PkgFile=nil) or (aFile.InUses and not PkgFile.InUses) then
|
|
begin
|
|
// a better file was found
|
|
PkgFile:=aFile;
|
|
PkgName:=Pkg.Name;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
MissingUnitName: string;
|
|
UsedByUnit: string;
|
|
Filename: String;
|
|
NewFilename: String;
|
|
CodeBuf: TCodeBuffer;
|
|
Owners: TFPList;
|
|
UsedByOwner: TObject;
|
|
PPUFilename: String;
|
|
PkgName: String;
|
|
OnlyInstalled: Boolean;
|
|
s: String;
|
|
PPUFiles: TStringList; // Strings:PPUFilename, Objects:TIDEPackage
|
|
i: Integer;
|
|
DepOwner: TObject;
|
|
PkgFile: TLazPackageFile;
|
|
begin
|
|
if MsgLine.Urgency<mluError then exit;
|
|
if not IsMsgID(MsgLine,FPCMsgIDCantFindUnitUsedBy,fMsgItemCantFindUnitUsedBy)
|
|
then // Can't find unit $1 used by $2
|
|
exit;
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
begin
|
|
NeedSynchronize:=true;
|
|
exit;
|
|
end;
|
|
etpspSynchronized: ;
|
|
etpspAfterSync: exit;
|
|
end;
|
|
|
|
if not GetFPCMsgValues(MsgLine,MissingUnitName,UsedByUnit) then
|
|
exit;
|
|
MsgLine.Attribute[FPCMsgAttrMissingUnit]:=MissingUnitName;
|
|
MsgLine.Attribute[FPCMsgAttrUsedByUnit]:=UsedByUnit;
|
|
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound Missing="',MissingUnitname,'" used by "',UsedByUnit,'"']);
|
|
{$ENDIF}
|
|
|
|
CodeBuf:=nil;
|
|
Filename:=MsgLine.GetFullFilename;
|
|
if (CompareFilenames(ExtractFileName(Filename),'staticpackages.inc')=0)
|
|
and ((ExtractFilePath(Filename)='')
|
|
or (CompareFilenames(ExtractFilePath(Filename),AppendPathDelim(GetPrimaryConfigPath))=0))
|
|
then begin
|
|
// common case: when building the IDE a package unit is missing
|
|
// staticpackages.inc(1,1) Fatal: Can't find unit sqldblaz used by Lazarus
|
|
// change to lazarus.pp(1,1)
|
|
Filename:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)+'ide'+PathDelim+'lazarus.pp';
|
|
MsgLine.SetSourcePosition(Filename,1,1);
|
|
MsgLine.Msg:=Format(lisCanTFindAValidPpu, [MissingUnitname]);
|
|
end else if SysUtils.CompareText(ExtractFileNameOnly(Filename),UsedByUnit)<>0
|
|
then begin
|
|
// the message belongs to another unit
|
|
NewFilename:='';
|
|
if FilenameIsAbsolute(Filename) then
|
|
begin
|
|
// For example: /path/laz/main.pp(1,1) Fatal: Can't find unit lazreport used by lazarus
|
|
// => search source 'lazarus' in directory
|
|
NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitInDirectory(
|
|
ExtractFilePath(Filename),UsedByUnit,true);
|
|
end;
|
|
if NewFilename='' then begin
|
|
NewFilename:=LazarusIDE.FindUnitFile(UsedByUnit);
|
|
if NewFilename='' then begin
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound unit not found: ',UsedByUnit]);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
if NewFilename<>'' then
|
|
Filename:=NewFilename;
|
|
end;
|
|
|
|
if FilenameIsAbsolute(Filename) then begin
|
|
CodeBuf:=CodeToolBoss.LoadFile(Filename,false,false);
|
|
if CodeBuf=nil then begin
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound unable to load unit: ',Filename]);
|
|
{$ENDIF}
|
|
end;
|
|
end else begin
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound unable to locate UsedByUnit: ',UsedByUnit,' Filename="',MsgLine.Filename,'" Attr[',FPCMsgAttrWorkerDirectory,']=',MsgLine.Attribute[FPCMsgAttrWorkerDirectory],' Tool.WorkerDirectory=',Tool.WorkerDirectory]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// fix line and column
|
|
Owners:=nil;
|
|
PPUFiles:=TStringList.Create;
|
|
try
|
|
UsedByOwner:=nil;
|
|
if CodeBuf<>nil then begin
|
|
FixSourcePos(CodeBuf,MissingUnitname);
|
|
Owners:=PackageEditingInterface.GetOwnersOfUnit(CodeBuf.Filename);
|
|
if (Owners<>nil) and (Owners.Count>0) then
|
|
UsedByOwner:=TObject(Owners[0]);
|
|
end;
|
|
|
|
// if the ppu exists then improve the message
|
|
if (CodeBuf<>nil) and FilenameIsAbsolute(CodeBuf.Filename) then begin
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound Filename=',CodeBuf.Filename]);
|
|
{$ENDIF}
|
|
PPUFilename:=CodeToolBoss.DirectoryCachePool.FindCompiledUnitInCompletePath(
|
|
ExtractFilePath(CodeBuf.Filename),MissingUnitname);
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TQuickFixUnitNotFoundPosition.Execute PPUFilename=',PPUFilename,' IsFileInIDESrcDir=',IsFileInIDESrcDir(CodeBuf.Filename)]);
|
|
{$ENDIF}
|
|
OnlyInstalled:=IsFileInIDESrcDir(CodeBuf.Filename);
|
|
if OnlyInstalled then begin
|
|
FindPPUInInstalledPkgs(MissingUnitname,PPUFiles);
|
|
end else if UsedByOwner<>nil then
|
|
FindPPUInModuleAndDeps(MissingUnitName,UsedByOwner,PPUFiles);
|
|
FindPackage(MissingUnitname,PkgName,OnlyInstalled,PkgFile);
|
|
if PPUFiles.Count>0 then begin
|
|
// there is a ppu file, but the compiler didn't like it
|
|
// => change message
|
|
s:=Format(lisCannotFind, [MissingUnitname]);
|
|
if UsedByUnit<>'' then
|
|
s+=Format(lisUsedBy, [UsedByUnit]);
|
|
s+=Format(lisIncompatiblePpu, [PPUFilename]);
|
|
if PPUFiles.Count=1 then
|
|
s+=Format(lisPackage3, [TIDEPackage(PPUFiles.Objects[0]).Name])
|
|
else begin
|
|
s+=lisMultiplePack;
|
|
for i:=0 to PPUFiles.Count-1 do begin
|
|
if i>0 then
|
|
s+=', ';
|
|
s+=TIDEPackage(PPUFiles.Objects[i]).Name;
|
|
end;
|
|
end;
|
|
end else begin
|
|
// there is no ppu file in the unit path
|
|
s:=Format(lisCannotFindUnit, [MissingUnitname]);
|
|
if UsedByUnit<>'' then
|
|
s+=Format(lisUsedBy, [UsedByUnit]);
|
|
if (UsedByOwner is TIDEPackage)
|
|
and (CompareTextCT(TIDEPackage(UsedByOwner).Name,PkgName)=0) then
|
|
begin
|
|
// two units of a package cannot find each other
|
|
s+=Format(lisCheckSearchPathPackageTryACleanRebuildCheckImpleme, [
|
|
TIDEPackage(UsedByOwner).Name]);
|
|
end else if (PkgName<>'')
|
|
and (OnlyInstalled
|
|
or ((UsedByOwner<>nil)
|
|
and PackageEditingInterface.IsOwnerDependingOnPkg(UsedByOwner,PkgName,DepOwner)))
|
|
then begin
|
|
// ppu file of an used package is missing
|
|
if (PkgFile<>nil) and (not PkgFile.InUses) then
|
|
s+=Format(lisEnableFlagUseUnitOfUnitInPackage, [MissingUnitName, PkgName])
|
|
else
|
|
s+=Format(lisCheckIfPackageCreatesPpuCheckNothingDeletesThisFil, [
|
|
PkgName, MissingUnitName]);
|
|
end else begin
|
|
if PkgName<>'' then
|
|
s+=Format(lisCheckIfPackageIsInTheDependencies, [PkgName]);
|
|
if UsedByOwner is TLazProject then
|
|
s+=lisOfTheProjectInspector
|
|
else if UsedByOwner is TIDEPackage then
|
|
s+=Format(lisOfPackage, [TIDEPackage(UsedByOwner).Name]);
|
|
end;
|
|
s+='.';
|
|
end;
|
|
MsgLine.Msg:=s;
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.ImproveMsgUnitNotFound Msg.Msg="',MsgLine.Msg,'"']);
|
|
{$ENDIF}
|
|
end;
|
|
finally
|
|
PPUFiles.Free;
|
|
Owners.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgLinkerUndefinedReference(
|
|
aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine);
|
|
|
|
function CheckForLinuxLDFileAndLineNumber: boolean;
|
|
{ For example:
|
|
/path/lib/x86_64-linux/blaunit.o: In function `FORMCREATE':
|
|
/path//blaunit.pas:45: undefined reference to `BLAUNIT_BLABLA'
|
|
}
|
|
var
|
|
p: PChar;
|
|
Msg: String;
|
|
aFilename: String;
|
|
LineNumber: Integer;
|
|
i: SizeInt;
|
|
begin
|
|
Result:=false;
|
|
if aPhase<>etpspAfterReadLine then exit;
|
|
if MsgLine.HasSourcePosition then exit;
|
|
Msg:=MsgLine.Msg;
|
|
p:=PChar(Msg);
|
|
// check for "filename:decimals: message"
|
|
// or unit1.o(.text+0x3a):unit1.pas:48: undefined reference to `DoesNotExist'
|
|
|
|
// read filename
|
|
repeat
|
|
if p^=#0 then exit;
|
|
inc(p);
|
|
until (p^=':') and (p[1] in ['0'..'9']);
|
|
aFilename:=LeftStr(Msg,p-PChar(Msg));
|
|
// check for something):filename
|
|
i:=Pos('):',aFilename);
|
|
if i>0 then
|
|
Delete(aFilename,1,i+1);
|
|
aFilename:=TrimFilename(aFilename);
|
|
|
|
// read line number
|
|
inc(p);
|
|
LineNumber:=0;
|
|
while p^ in ['0'..'9'] do begin
|
|
LineNumber:=LineNumber*10+ord(p^)-ord('0');
|
|
if LineNumber>9999999 then exit;
|
|
inc(p);
|
|
end;
|
|
if p^<>':' then exit;
|
|
inc(p);
|
|
while p^ in [' '] do inc(p);
|
|
|
|
Result:=true;
|
|
MsgLine.Msg:=copy(Msg,p-PChar(Msg)+1,length(Msg));
|
|
MsgLine.SetSourcePosition(aFilename,LineNumber,1);
|
|
MsgLine.Urgency:=mluError;
|
|
end;
|
|
|
|
function CheckForDarwinLDReferencedFrom: boolean;
|
|
{ For example:
|
|
"_UNIT1_GIBTESNICHT", referenced from:
|
|
}
|
|
var
|
|
MangledName: string;
|
|
aComplete: boolean;
|
|
aErrorMsg: string;
|
|
NewCode: TCodeBuffer;
|
|
NewX: integer;
|
|
NewY: integer;
|
|
NewTopLine: integer;
|
|
begin
|
|
Result:=false;
|
|
if MsgLine.HasSourcePosition then exit;
|
|
// check for ' "_FPC-Mangled-Identifier", referenced from:
|
|
if not etFPCMsgParser.GetFPCMsgValue1(MsgLine.Msg,' "_$1", referenced from:',
|
|
MangledName)
|
|
then exit;
|
|
Result:=true;
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
begin
|
|
NeedSynchronize:=true;
|
|
exit;
|
|
end;
|
|
etpspAfterSync: exit;
|
|
end;
|
|
// in main thread
|
|
CodeToolBoss.FindFPCMangledIdentifier(MangledName,aComplete,aErrorMsg,
|
|
nil,NewCode,NewX,NewY,NewTopLine);
|
|
if NewCode=nil then exit;
|
|
Result:=true;
|
|
MsgLine.SetSourcePosition(NewCode.Filename,NewY,NewX);
|
|
MsgLine.Urgency:=mluError;
|
|
end;
|
|
|
|
function CheckForDarwinLDMangledInO: boolean;
|
|
{ For example:
|
|
_UNIT1_TFORM1_$__FORMCREATE$TOBJECT in unit1.o
|
|
}
|
|
var
|
|
MangledName: string;
|
|
aUnitName: string;
|
|
aComplete: boolean;
|
|
aErrorMsg: string;
|
|
NewCode: TCodeBuffer;
|
|
NewX: integer;
|
|
NewY: integer;
|
|
NewTopLine: integer;
|
|
begin
|
|
Result:=false;
|
|
if MsgLine.HasSourcePosition then exit;
|
|
if not etFPCMsgParser.GetFPCMsgValues2(MsgLine.Msg,' _$1 in $2.o',
|
|
MangledName,aUnitName)
|
|
then exit;
|
|
Result:=true;
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
begin
|
|
NeedSynchronize:=true;
|
|
exit;
|
|
end;
|
|
etpspAfterSync: exit;
|
|
end;
|
|
// in main thread
|
|
CodeToolBoss.FindFPCMangledIdentifier(MangledName,aComplete,aErrorMsg,
|
|
nil,NewCode,NewX,NewY,NewTopLine);
|
|
if NewCode=nil then exit;
|
|
Result:=true;
|
|
MsgLine.SetSourcePosition(NewCode.Filename,NewY,NewX);
|
|
MsgLine.Urgency:=mluError;
|
|
end;
|
|
|
|
begin
|
|
if MsgLine.SubTool<>SubToolFPCLinker then exit;
|
|
|
|
if CheckForLinuxLDFileAndLineNumber then exit;
|
|
if CheckForDarwinLDReferencedFrom then exit;
|
|
if CheckForDarwinLDMangledInO then exit;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMsgIdentifierPosition(
|
|
aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine; SourceOK: boolean);
|
|
{ FPC report the token after the identifier
|
|
=> fix the position
|
|
Examples:
|
|
" i :="
|
|
unit1.pas(42,5) Error: (5000) Identifier not found "i"
|
|
|
|
"procedure TMyClass.DoIt ;"
|
|
test.pas(7,26) Error: (3047) method identifier expected
|
|
}
|
|
const
|
|
AttrPosChecked = 'PosChecked';
|
|
var
|
|
LineRange: TLineRange;
|
|
Line, Col: Integer;
|
|
p, AtomEnd: integer;
|
|
Src: String;
|
|
Identifier: String;
|
|
begin
|
|
Col:=MsgLine.Column;
|
|
Line:=MsgLine.Line;
|
|
if (Col<1) or (Line<1) then
|
|
exit;
|
|
if (Line=1) and (Col=1) then exit;
|
|
if (not IsMsgID(MsgLine,FPCMsgIDIdentifierNotFound,fMsgItemIdentifierNotFound))
|
|
and (not IsMsgID(MsgLine,FPCMsgIDMethodIdentifierExpected,fMsgItemMethodIdentifierExpected))
|
|
then
|
|
exit;
|
|
if MsgLine.Attribute[AttrPosChecked]<>'' then exit;
|
|
if NeedSource(aPhase,SourceOK) then
|
|
exit;
|
|
MsgLine.Attribute[AttrPosChecked]:=ClassName;
|
|
|
|
//DebuglnThreadLog(['Old Line=',Line,' ',MsgLine.Column]);
|
|
if Line>=fCurSource.LineCount then exit;
|
|
if MsgLine.MsgID=FPCMsgIDIdentifierNotFound then begin
|
|
Identifier:=GetFPCMsgValue1(MsgLine);
|
|
if Identifier='' then exit;
|
|
end else
|
|
Identifier:='';
|
|
fCurSource.GetLineRange(Line-1,LineRange);
|
|
//DebuglnThreadLog(['Old Range=',LineRange.StartPos,'-',LineRange.EndPos,' Str="',copy(fCurSource.Source,LineRange.StartPos,LineRange.EndPos-LineRange.StartPos),'"']);
|
|
Col:=Min(Col,LineRange.EndPos-LineRange.StartPos+1);
|
|
p:=LineRange.StartPos+Col-1;
|
|
Src:=fCurSource.Source;
|
|
if Identifier<>'' then begin
|
|
// message is about a specific identifier
|
|
if CompareIdentifiers(PChar(Identifier),@Src[p])=0 then begin
|
|
// already pointing at the right identifier
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// message is about any one identifier
|
|
if IsIdentStartChar[Src[p]] then begin
|
|
// already pointing at an identifier
|
|
exit;
|
|
end;
|
|
end;
|
|
// go to prior token
|
|
//DebuglnThreadLog(['New Line=',Line,' Col=',Col,' p=',p]);
|
|
ReadPriorPascalAtom(Src,p,AtomEnd,false);
|
|
if p<1 then exit;
|
|
if Identifier<>'' then begin
|
|
// message is about a specific identifier
|
|
if CompareIdentifiers(PChar(Identifier),@Src[p])<>0 then begin
|
|
// the prior token is not the identifier neither
|
|
// => don't know
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// message is about any one identifier
|
|
if not IsIdentStartChar[Src[p]] then begin
|
|
// the prior token is not an identifier neither
|
|
// => don't know
|
|
exit;
|
|
end;
|
|
end;
|
|
fCurSource.AbsoluteToLineCol(p,Line,Col);
|
|
//DebuglnThreadLog(['New Line=',Line,' Col=',Col,' p=',p]);
|
|
if (Line<1) or (Col<1) then exit;
|
|
MsgLine.SetSourcePosition(MsgLine.Filename,Line,Col)
|
|
end;
|
|
|
|
procedure TIDEFPCParser.Translate(p: PChar; MsgItem, TranslatedItem: TFPCMsgItem;
|
|
out TranslatedMsg: String; out MsgType: TMessageLineUrgency);
|
|
begin
|
|
TranslatedMsg:='';
|
|
MsgType:=mluNone;
|
|
if TranslatedItem<>nil then
|
|
MsgType:=FPCMsgToMsgUrgency(TranslatedItem);
|
|
if (MsgType=mluNone) and (MsgItem<>nil) then
|
|
MsgType:=FPCMsgToMsgUrgency(MsgItem);
|
|
if TranslatedItem<>nil then begin
|
|
if System.Pos('$',TranslatedItem.Pattern)<1 then begin
|
|
TranslatedMsg:=TranslatedItem.Pattern;
|
|
LazUTF8.UTF8FixBroken(TranslatedMsg);
|
|
end
|
|
else if MsgItem<>nil then
|
|
TranslatedMsg:=TranslateFPCMsg(p,MsgItem.Pattern,TranslatedItem.Pattern);
|
|
//debugln(['TFPCParser.Translate Translation="',TranslatedMsg,'"']);
|
|
end;
|
|
end;
|
|
|
|
constructor TIDEFPCParser.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
fMissingFPCMsgItem:=TFPCMsgItem(Pointer(1));
|
|
fLineToMsgID:=TPatternToMsgIDs.Create;
|
|
fFileExists:=TFilenameToPointerTree.Create(false);
|
|
FFilesToIgnoreUnitNotUsed:=TStringList.Create;
|
|
HideHintsSenderNotUsed:=true;
|
|
HideHintsUnitNotUsedInMainSource:=true;
|
|
end;
|
|
|
|
function TIDEFPCParser.FileExists(const Filename: string; aSynchronized: boolean
|
|
): boolean;
|
|
var
|
|
p: Pointer;
|
|
begin
|
|
// check internal cache
|
|
p:=fFileExists[Filename];
|
|
if p=Pointer(Self) then
|
|
Result:=true
|
|
else if p=Pointer(fFileExists) then
|
|
Result:=false
|
|
else begin
|
|
// check disk
|
|
if aSynchronized then
|
|
Result:=FileExistsCached(Filename)
|
|
else
|
|
Result:=FileExistsUTF8(Filename);
|
|
// save result
|
|
if Result then
|
|
fFileExists[Filename]:=Pointer(Self)
|
|
else
|
|
fFileExists[Filename]:=Pointer(fFileExists);
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.FetchIncludePath(aPhase: TExtToolParserSyncPhase;
|
|
MsgWorkerDir: String);
|
|
begin
|
|
if MsgWorkerDir='' then
|
|
MsgWorkerDir:=Tool.WorkerDirectory;
|
|
if fIncludePathValidForWorkerDir<>MsgWorkerDir then begin
|
|
// fetch include path from IDE
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
NeedSynchronize:=true;
|
|
etpspSynchronized:
|
|
begin
|
|
fIncludePathValidForWorkerDir:=MsgWorkerDir;
|
|
fIncludePath:=CodeToolBoss.GetIncludePathForDirectory(
|
|
ChompPathDelim(MsgWorkerDir));
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
debugln(['TIDEFPCParser.FetchIncludePath ',fIncludePath]);
|
|
{$ENDIF}
|
|
NeedAfterSync:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.FetchUnitPath(aPhase: TExtToolParserSyncPhase;
|
|
MsgWorkerDir: String);
|
|
begin
|
|
if MsgWorkerDir='' then
|
|
MsgWorkerDir:=Tool.WorkerDirectory;
|
|
if fUnitPathValidForWorkerDir<>MsgWorkerDir then begin
|
|
// fetch unit path from IDE
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
NeedSynchronize:=true;
|
|
etpspSynchronized:
|
|
begin
|
|
fUnitPathValidForWorkerDir:=MsgWorkerDir;
|
|
fUnitPath:=CodeToolBoss.GetUnitPathForDirectory(
|
|
ChompPathDelim(MsgWorkerDir));
|
|
NeedAfterSync:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForMsgId(p: PChar): boolean;
|
|
var
|
|
MsgItem: TFPCMsgItem;
|
|
TranslatedItem: TFPCMsgItem;
|
|
MsgLine: TMessageLine;
|
|
TranslatedMsg: String;
|
|
MsgType: TMessageLineUrgency;
|
|
Msg: string;
|
|
begin
|
|
Result:=false;
|
|
if (fMsgID<1) or (MsgFile=nil) then exit;
|
|
MsgItem:=MsgFile.GetMsg(fMsgID);
|
|
if MsgItem=nil then exit;
|
|
Result:=true;
|
|
TranslatedItem:=nil;
|
|
if (TranslationFile<>nil) then
|
|
TranslatedItem:=TranslationFile.GetMsg(fMsgID);
|
|
Translate(p,MsgItem,TranslatedItem,TranslatedMsg,MsgType);
|
|
Msg:=p;
|
|
case fMsgID of
|
|
FPCMsgIDErrorWhileCompilingResources: // Error while compiling resources
|
|
Msg+=' -> Compile with -vd for more details. Check for duplicates.';
|
|
FPCMsgIDThereWereErrorsCompiling: // There were $1 errors compiling module, stopping
|
|
MsgType:=mluVerbose;
|
|
end;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=MsgType;
|
|
MsgLine.Msg:=Msg;
|
|
MsgLine.TranslatedMsg:=TranslatedMsg;
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForFileLineColMessage(p: PChar): boolean;
|
|
{ filename(line,column) Hint: message
|
|
filename(line,column) Hint: (msgid) message
|
|
filename(line) Hint: (msgid) message
|
|
}
|
|
var
|
|
FileStartPos: PChar;
|
|
FileEndPos: PChar;
|
|
LineStartPos: PChar;
|
|
ColStartPos: PChar;
|
|
MsgType: TMessageLineUrgency;
|
|
MsgLine: TMessageLine;
|
|
p2: PChar;
|
|
i: Integer;
|
|
TranslatedItem: TFPCMsgItem;
|
|
MsgItem: TFPCMsgItem;
|
|
TranslatedMsg: String;
|
|
aFilename: String;
|
|
Column: Integer;
|
|
begin
|
|
Result:=false;
|
|
FileStartPos:=p;
|
|
while not (p^ in ['(',#0]) do inc(p);
|
|
if (p^<>'(') or (p=FileStartPos) or (p[-1]=' ') then exit;
|
|
FileEndPos:=p;
|
|
inc(p); // skip bracket
|
|
LineStartPos:=p;
|
|
if not ReadDecimal(p) then exit;
|
|
if p^=',' then begin
|
|
if not ReadChar(p,',') then exit;
|
|
ColStartPos:=p;
|
|
if not ReadDecimal(p) then exit;
|
|
end else
|
|
ColStartPos:=nil;
|
|
if not ReadChar(p,')') then exit;
|
|
if not ReadChar(p,' ') then exit;
|
|
MsgType:=mluNote;
|
|
if ReadString(p,'Hint:') then begin
|
|
MsgType:=mluHint;
|
|
end else if ReadString(p,'Note:') then begin
|
|
MsgType:=mluNote;
|
|
end else if ReadString(p,'Warn:') then begin
|
|
MsgType:=mluWarning;
|
|
end else if ReadString(p,'Error:') then begin
|
|
MsgType:=mluError;
|
|
end else if ReadString(p,'Fatal:') then begin
|
|
MsgType:=mluError;
|
|
end else begin
|
|
p2:=p;
|
|
while not (p2^ in [':',#0,' ']) do inc(p2);
|
|
if p2^=':' then begin
|
|
// unknown type (maybe a translation?)
|
|
p:=p2+1;
|
|
end;
|
|
end;
|
|
while p^ in [' ',#9] do inc(p);
|
|
Result:=true;
|
|
TranslatedMsg:='';
|
|
if (p^='(') and (p[1] in ['0'..'9']) then begin
|
|
// (msgid)
|
|
p2:=p;
|
|
inc(p2);
|
|
i:=0;
|
|
while (p2^ in ['0'..'9']) and (i<1000000) do begin
|
|
i:=i*10+ord(p2^)-ord('0');
|
|
inc(p2);
|
|
end;
|
|
if p2^=')' then begin
|
|
fMsgID:=i;
|
|
p:=p2+1;
|
|
while p^ in [' ',#9] do inc(p);
|
|
//debugln(['TFPCParser.CheckForFileLineColMessage ID=',fMsgID,' Msg=',FileStartPos]);
|
|
if (fMsgID>0) then begin
|
|
TranslatedItem:=nil;
|
|
MsgItem:=nil;
|
|
if (TranslationFile<>nil) then
|
|
TranslatedItem:=TranslationFile.GetMsg(fMsgID);
|
|
if (MsgFile<>nil) then
|
|
MsgItem:=MsgFile.GetMsg(fMsgID);
|
|
Translate(p,MsgItem,TranslatedItem,TranslatedMsg,MsgType);
|
|
if (TranslatedItem=nil) and (MsgItem=nil) then begin
|
|
if ConsoleVerbosity>=0 then
|
|
debugln(['TFPCParser.CheckForFileLineColMessage msgid not found: ',fMsgID]);
|
|
end else if MsgType=mluNone then begin
|
|
if ConsoleVerbosity>=0 then
|
|
debugln(['TFPCParser.CheckForFileLineColMessage msgid has no type: ',fMsgID]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if ColStartPos<>nil then
|
|
Column:=Str2Integer(ColStartPos,0)
|
|
else
|
|
Column:=0;
|
|
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=MsgType;
|
|
aFilename:=GetString(FileStartPos,FileEndPos-FileStartPos);
|
|
MsgLine.Filename:=LongenFilename(MsgLine,aFilename);
|
|
MsgLine.Line:=Str2Integer(LineStartPos,0);
|
|
MsgLine.Column:=Column;
|
|
MsgLine.Msg:=p;
|
|
MsgLine.TranslatedMsg:=TranslatedMsg;
|
|
//debugln(['TFPCParser.CheckForFileLineColMessage ',dbgs(MsgLine.Urgency)]);
|
|
|
|
AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.CheckForLoadFromUnit(p: PChar): Boolean;
|
|
var
|
|
OldP: PChar;
|
|
MsgLine: TMessageLine;
|
|
begin
|
|
Result:=fMsgID=10027;
|
|
if (fMsgID>0) and not Result then exit;
|
|
OldP:=p;
|
|
if not Result then begin
|
|
if not ReadString(p,'Load from ') then exit;
|
|
while not (p^ in ['(',#0]) do inc(p);
|
|
if p^<>'(' then exit;
|
|
while not (p^ in [')',#0]) do inc(p);
|
|
if p^<>')' then exit;
|
|
if not ReadString(p,') unit ') then exit;
|
|
end;
|
|
MsgLine:=CreateMsgLine;
|
|
MsgLine.SubTool:=SubToolFPC;
|
|
MsgLine.Urgency:=mluProgress;
|
|
MsgLine.Msg:=OldP;
|
|
AddMsgLine(MsgLine);
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ReadLine(Line: string; OutputIndex: integer;
|
|
var Handled: boolean);
|
|
{ returns true, if it is a compiler message
|
|
Examples for freepascal compiler messages:
|
|
Compiling <filename>
|
|
Assembling <filename>
|
|
Fatal: <some text>
|
|
Fatal: (message id) <some text>
|
|
(message id) <some text>
|
|
<filename>(123,45) <ErrorType>: <some text>
|
|
<filename>(123) <ErrorType>: <some text>
|
|
<filename>(456) <ErrorType>: <some text> in line (123)
|
|
[0.000] (3101) Macro defined: CPUAMD64
|
|
<filename>(12,34) <ErrorType>: (5024) <some text>
|
|
}
|
|
var
|
|
p: PChar;
|
|
begin
|
|
if Line='' then exit;
|
|
p:=PChar(Line);
|
|
fOutputIndex:=OutputIndex;
|
|
fMsgID:=0;
|
|
|
|
// skip time [0.000]
|
|
if (p^='[') and (p[1] in ['0'..'9']) then begin
|
|
inc(p,2);
|
|
while p^ in ['0'..'9','.'] do inc(p);
|
|
if p^<>']' then exit; // not a fpc message
|
|
inc(p);
|
|
while p^ in [' '] do inc(p);
|
|
end;
|
|
|
|
// read message ID (000)
|
|
if (p^='(') and (p[1] in ['0'..'9']) then begin
|
|
inc(p);
|
|
while p^ in ['0'..'9','.'] do begin
|
|
if fMsgID>1000000 then exit; // not a fpc message
|
|
fMsgID:=fMsgID*10+ord(p^)-ord('0');
|
|
inc(p);
|
|
end;
|
|
if p^<>')' then exit; // not a fpc message
|
|
inc(p);
|
|
while p^ in [' '] do inc(p);
|
|
end;
|
|
|
|
if p^ in [#0..#31,' '] then exit; // not a fpc message
|
|
|
|
Handled:=true;
|
|
|
|
// check for (msgid) message
|
|
if CheckForMsgId(p) then exit;
|
|
// check for 'filename(line,column) Error: message'
|
|
if CheckForFileLineColMessage(p) then exit;
|
|
// check for 'Compiling <filename>'
|
|
if CheckForCompilingState(p) then exit;
|
|
// check for 'Assembling <filename>'
|
|
if CheckForAssemblingState(p) then exit;
|
|
// check for 'Fatal: ', 'Panic: ', 'Error: ', ...
|
|
if CheckForGeneralMessage(p) then exit;
|
|
// check for '<line> <kb>/<kb>'...
|
|
if CheckForLineProgress(p) then exit;
|
|
// check for '<int> Lines compiled, <int>.<int> sec'
|
|
if CheckForLinesCompiled(p) then exit;
|
|
// check for infos (logo, Linking <Progname>)
|
|
if CheckForInfos(p) then exit;
|
|
// check for -vx output
|
|
if CheckForExecutableInfo(p) then exit;
|
|
// check for Load from unit
|
|
if CheckForLoadFromUnit(p) then exit;
|
|
// check for windres errors
|
|
if CheckForWindresErrors(p) then exit;
|
|
|
|
{$IFDEF VerboseFPCParser}
|
|
debugln('TFPCParser.ReadLine UNKNOWN: ',Line);
|
|
{$ENDIF}
|
|
Handled:=false;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.AddMsgLine(MsgLine: TMessageLine);
|
|
begin
|
|
if IsMsgID(MsgLine,FPCMsgIDErrorWhileCompilingResources,
|
|
fMsgItemErrorWhileCompilingResources)
|
|
then begin
|
|
// Error while compiling resources
|
|
AddResourceMessages;
|
|
MsgLine.Msg:=Format(lisCompileWithVdForMoreDetailsCheckForDuplicates, [
|
|
MsgLine.Msg]);
|
|
end
|
|
else if IsMsgID(MsgLine,FPCMsgIDErrorWhileLinking,fMsgItemErrorWhileLinking) then
|
|
AddLinkingMessages
|
|
else if IsMsgID(MsgLine,FPCMsgIDChecksumChanged,fMsgItemChecksumChanged) then
|
|
MsgLine.Urgency:=mluWarning
|
|
else if IsMsgID(MsgLine,FPCMsgIDThereWereErrorsCompiling,
|
|
fMsgItemThereWereErrorsCompiling)
|
|
then
|
|
MsgLine.Urgency:=mluVerbose;
|
|
inherited AddMsgLine(MsgLine);
|
|
end;
|
|
|
|
function TIDEFPCParser.LongenFilename(MsgLine: TMessageLine; aFilename: string
|
|
): string;
|
|
var
|
|
ShortFilename: String;
|
|
i: Integer;
|
|
LastMsgLine: TMessageLine;
|
|
LastFilename: String;
|
|
begin
|
|
Result:=TrimFilename(aFilename);
|
|
if FilenameIsAbsolute(Result) then exit;
|
|
ShortFilename:=Result;
|
|
// check last message line
|
|
LastMsgLine:=Tool.WorkerMessages.GetLastLine;
|
|
if (LastMsgLine<>nil) then begin
|
|
LastFilename:=LastMsgLine.Filename;
|
|
if FilenameIsAbsolute(LastFilename) then begin
|
|
if (length(LastFilename)>length(ShortFilename))
|
|
and (LastFilename[length(LastFilename)-length(ShortFilename)] in AllowDirectorySeparators)
|
|
and (CompareFilenames(RightStr(LastFilename,length(ShortFilename)),ShortFilename)=0)
|
|
then begin
|
|
Result:=LastFilename;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
// search file in the last compiling directories
|
|
if DirectoryStack<>nil then begin
|
|
for i:=DirectoryStack.Count-1 downto 0 do begin
|
|
Result:=AppendPathDelim(DirectoryStack[i])+ShortFilename;
|
|
if FileExists(Result,false) then exit;
|
|
end;
|
|
end;
|
|
// search file in worker directory
|
|
if Tool.WorkerDirectory<>'' then begin
|
|
Result:=AppendPathDelim(Tool.WorkerDirectory)+ShortFilename;
|
|
if FileExists(Result,false) then exit;
|
|
end;
|
|
|
|
// file not found
|
|
Result:=ShortFilename;
|
|
|
|
// save Tool.WorkerDirectory for ImproveMessage
|
|
MsgLine.Attribute[FPCMsgAttrWorkerDirectory]:=Tool.WorkerDirectory;
|
|
end;
|
|
|
|
procedure TIDEFPCParser.ImproveMessages(aPhase: TExtToolParserSyncPhase);
|
|
var
|
|
i: Integer;
|
|
MsgLine: TMessageLine;
|
|
aFilename: String;
|
|
Y: Integer;
|
|
X: Integer;
|
|
Code: TCodeBuffer;
|
|
SourceOK: Boolean;
|
|
MsgWorkerDir: String;
|
|
PrevMsgLine: TMessageLine;
|
|
CmdLineParams: String;
|
|
SrcFilename: String;
|
|
begin
|
|
//debugln(['TIDEFPCParser.ImproveMessages START ',aSynchronized,' Last=',fLastWorkerImprovedMessage[aSynchronized],' Now=',Tool.WorkerMessages.Count]);
|
|
for i:=fLastWorkerImprovedMessage[aPhase]+1 to Tool.WorkerMessages.Count-1 do
|
|
begin
|
|
MsgLine:=Tool.WorkerMessages[i];
|
|
Y:=MsgLine.Line;
|
|
X:=MsgLine.Column;
|
|
if (Y>0) and (X>0)
|
|
and (MsgLine.SubTool=SubToolFPC) and (MsgLine.Filename<>'')
|
|
then begin
|
|
aFilename:=MsgLine.Filename;
|
|
if (not FilenameIsAbsolute(aFilename)) then begin
|
|
// short file name => 1. search the full file name in previous message
|
|
if i>0 then begin
|
|
PrevMsgLine:=Tool.WorkerMessages[i-1];
|
|
if (PrevMsgLine.SubTool=SubToolFPC)
|
|
and FilenameIsAbsolute(PrevMsgLine.Filename)
|
|
and (CompareFilenames(ExtractFilename(PrevMsgLine.Filename),ExtractFilename(aFilename))=0)
|
|
then begin
|
|
// same file as previous message => use it
|
|
aFilename:=PrevMsgLine.Filename;
|
|
MsgLine.Filename:=aFilename;
|
|
end;
|
|
end;
|
|
end;
|
|
if (not FilenameIsAbsolute(aFilename)) then begin
|
|
// short file name => 2. search in include path
|
|
MsgWorkerDir:=MsgLine.Attribute[FPCMsgAttrWorkerDirectory];
|
|
FetchIncludePath(aPhase,MsgWorkerDir); // needs Phase etpspAfterReadLine+etpspSynchronized
|
|
{$IFDEF VerboseFPCMsgUnitNotFound}
|
|
if aPhase=etpspSynchronized then
|
|
debugln(['TIDEFPCParser.ImproveMessages IncPath="',fIncludePath,'" aFilename="',aFilename,'" MsgWorkerDir="',MsgWorkerDir,'"']);
|
|
{$ENDIF}
|
|
if (aPhase in [etpspAfterReadLine,etpspAfterSync])
|
|
and (fIncludePathValidForWorkerDir=MsgWorkerDir) then begin
|
|
// include path is valid and in worker thread
|
|
// -> search file
|
|
aFilename:=SearchFileInPath(aFilename,MsgWorkerDir,fIncludePath,';',
|
|
[sffSearchLoUpCase]);
|
|
if aFilename<>'' then
|
|
MsgLine.Filename:=aFilename;
|
|
end;
|
|
end;
|
|
if (not FilenameIsAbsolute(aFilename)) and (aPhase=etpspAfterReadLine)
|
|
then begin
|
|
CmdLineParams:=Tool.CmdLineParams;
|
|
if Pos(CmdLineParams,PathDelim+'fpc'+ExeExt+' ')>0 then begin
|
|
// short file name => 3. check the cmd line param source file
|
|
SrcFilename:=GetFPCParameterSrcFile(Tool.CmdLineParams);
|
|
if (SrcFilename<>'')
|
|
and ((CompareFilenames(ExtractFilename(SrcFilename),aFilename)=0)
|
|
or (CompareFilenames(ExtractFileNameOnly(SrcFilename),aFilename)=0))
|
|
then begin
|
|
if not FilenameIsAbsolute(SrcFilename) then begin
|
|
MsgWorkerDir:=MsgLine.Attribute[FPCMsgAttrWorkerDirectory];
|
|
SrcFilename:=ResolveDots(AppendPathDelim(MsgWorkerDir)+SrcFilename);
|
|
end;
|
|
if FilenameIsAbsolute(SrcFilename) then
|
|
MsgLine.Filename:=SrcFilename;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// get source
|
|
SourceOK:=false;
|
|
aFilename:=MsgLine.Filename;
|
|
if FilenameIsAbsolute(aFilename) then begin
|
|
if (fCurSource<>nil)
|
|
and (CompareFilenames(aFilename,fCurSource.Filename)=0) then begin
|
|
SourceOK:=true;
|
|
end else begin
|
|
// need source
|
|
case aPhase of
|
|
etpspAfterReadLine:
|
|
NeedSynchronize:=true;
|
|
etpspSynchronized:
|
|
begin
|
|
// load source file
|
|
//debugln(['TFPCParser.ImproveMessages loading ',aFilename]);
|
|
Code:=CodeToolBoss.LoadFile(aFilename,true,false);
|
|
if Code<>nil then begin
|
|
if fCurSource=nil then
|
|
fCurSource:=TCodeBuffer.Create;
|
|
fCurSource.Filename:=aFilename;
|
|
if Code.FileOnDiskNeedsUpdate then begin
|
|
// IDE buffer contains changes that are not yet saved to disk
|
|
// The compiler messages are about the disk file
|
|
// => load the file
|
|
fCurSource.LoadFromFile(aFilename);
|
|
end else begin
|
|
// IDE buffer valid => just copy
|
|
fCurSource.Source:=Code.Source;
|
|
end;
|
|
SourceOK:=true;
|
|
NeedAfterSync:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
ImproveMsgHiddenByIDEDirective(aPhase, MsgLine, SourceOK);
|
|
ImproveMsgUnitNotUsed(aPhase, MsgLine);
|
|
ImproveMsgSenderNotUsed(aPhase, MsgLine);
|
|
ImproveMsgIdentifierPosition(aPhase, MsgLine, SourceOK);
|
|
end else if MsgLine.SubTool=SubToolFPCLinker then begin
|
|
ImproveMsgLinkerUndefinedReference(aPhase, MsgLine);
|
|
end;
|
|
ImproveMsgUnitNotFound(aPhase, MsgLine);
|
|
end;
|
|
fLastWorkerImprovedMessage[aPhase]:=Tool.WorkerMessages.Count-1;
|
|
end;
|
|
|
|
class function TIDEFPCParser.IsSubTool(const SubTool: string): boolean;
|
|
begin
|
|
Result:=(CompareText(SubTool,SubToolFPC)=0)
|
|
or (CompareText(SubTool,SubToolFPCLinker)=0)
|
|
or (CompareText(SubTool,SubToolFPCRes)=0);
|
|
end;
|
|
|
|
class function TIDEFPCParser.DefaultSubTool: string;
|
|
begin
|
|
Result:=SubToolFPC;
|
|
end;
|
|
|
|
class function TIDEFPCParser.GetMsgHint(SubTool: string; MsgID: integer): string;
|
|
var
|
|
CurMsgFile: TFPCMsgFilePoolItem;
|
|
MsgItem: TFPCMsgItem;
|
|
begin
|
|
Result:='';
|
|
if CompareText(SubTool,SubToolFPC)=0 then begin
|
|
CurMsgFile:=FPCMsgFilePool.LoadCurrentEnglishFile(false,nil);
|
|
if CurMsgFile=nil then exit;
|
|
try
|
|
MsgItem:=CurMsgFile.GetMsg(MsgID);
|
|
if MsgItem=nil then exit;
|
|
Result:=MsgItem.GetTrimmedComment(false,true);
|
|
finally
|
|
FPCMsgFilePool.UnloadFile(CurMsgFile);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TIDEFPCParser.GetMsgPattern(SubTool: string; MsgID: integer; out
|
|
Urgency: TMessageLineUrgency): string;
|
|
var
|
|
CurMsgFile: TFPCMsgFilePoolItem;
|
|
MsgItem: TFPCMsgItem;
|
|
begin
|
|
Result:='';
|
|
Urgency:=mluNone;
|
|
if CompareText(SubTool,SubToolFPC)=0 then begin
|
|
if FPCMsgFilePool=nil then exit;
|
|
CurMsgFile:=FPCMsgFilePool.LoadCurrentEnglishFile(false,nil);
|
|
if CurMsgFile=nil then exit;
|
|
try
|
|
MsgItem:=CurMsgFile.GetMsg(MsgID);
|
|
if MsgItem=nil then exit;
|
|
Result:=MsgItem.Pattern;
|
|
Urgency:=FPCMsgToMsgUrgency(MsgItem);
|
|
finally
|
|
FPCMsgFilePool.UnloadFile(CurMsgFile);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TIDEFPCParser.Priority: integer;
|
|
begin
|
|
Result:=SubToolFPCPriority;
|
|
end;
|
|
|
|
class function TIDEFPCParser.MsgLineIsId(Msg: TMessageLine; MsgId: integer; out
|
|
Value1, Value2: string): boolean;
|
|
|
|
function GetStr(FromPos, ToPos: PChar): string;
|
|
begin
|
|
if (FromPos=nil) or (FromPos=ToPos) then
|
|
Result:=''
|
|
else begin
|
|
SetLength(Result,ToPos-FromPos);
|
|
Move(FromPos^,Result[1],ToPos-FromPos);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
aFPCParser: TFPCParser;
|
|
Pattern: String;
|
|
VarStarts: PPChar;
|
|
VarEnds: PPChar;
|
|
s: String;
|
|
begin
|
|
Value1:='';
|
|
Value2:='';
|
|
if Msg=nil then exit(false);
|
|
if Msg.SubTool<>SubToolFPC then exit(false);
|
|
if (Msg.MsgID<>MsgId)
|
|
and (Msg.MsgID<>0) then exit(false);
|
|
Result:=true;
|
|
aFPCParser:=GetFPCParser(Msg);
|
|
if aFPCParser=nil then exit;
|
|
Pattern:=aFPCParser.GetFPCMsgIDPattern(MsgId);
|
|
VarStarts:=GetMem(SizeOf(PChar)*10);
|
|
VarEnds:=GetMem(SizeOf(PChar)*10);
|
|
s:=Msg.Msg;
|
|
Result:=FPCMsgFits(s,Pattern,VarStarts,VarEnds);
|
|
if Result then begin
|
|
Value1:=GetStr(VarStarts[1],VarEnds[1]);
|
|
Value2:=GetStr(VarStarts[2],VarEnds[2]);
|
|
end;
|
|
Freemem(VarStarts);
|
|
Freemem(VarEnds);
|
|
end;
|
|
|
|
function TIDEFPCParser.GetFPCMsgIDPattern(MsgID: integer): string;
|
|
var
|
|
MsgItem: TFPCMsgItem;
|
|
begin
|
|
Result:='';
|
|
if MsgID<=0 then exit;
|
|
if MsgFile=nil then exit;
|
|
MsgItem:=MsgFile.GetMsg(MsgID);
|
|
if MsgItem=nil then exit;
|
|
Result:=MsgItem.Pattern;
|
|
end;
|
|
|
|
class function TIDEFPCParser.GetFPCMsgPattern(Msg: TMessageLine): string;
|
|
var
|
|
aFPCParser: TFPCParser;
|
|
begin
|
|
Result:='';
|
|
if Msg.MsgID<=0 then exit;
|
|
aFPCParser:=GetFPCParser(Msg);
|
|
if aFPCParser=nil then exit;
|
|
Result:=aFPCParser.GetFPCMsgIDPattern(Msg.MsgID);
|
|
end;
|
|
|
|
class function TIDEFPCParser.GetFPCMsgValue1(Msg: TMessageLine): string;
|
|
begin
|
|
Result:='';
|
|
if Msg.MsgID<=0 then exit;
|
|
if Msg.SubTool<>SubToolFPC then exit;
|
|
if not etFPCMsgParser.GetFPCMsgValue1(Msg.Msg,GetFPCMsgPattern(Msg),Result) then
|
|
Result:='';
|
|
end;
|
|
|
|
class function TIDEFPCParser.GetFPCMsgValues(Msg: TMessageLine; out Value1,
|
|
Value2: string): boolean;
|
|
begin
|
|
Result:=false;
|
|
if Msg.MsgID<=0 then exit;
|
|
if Msg.SubTool<>SubToolFPC then exit;
|
|
Result:=etFPCMsgParser.GetFPCMsgValues2(Msg.Msg,GetFPCMsgPattern(Msg),Value1,Value2);
|
|
end;
|
|
|
|
initialization
|
|
IDEFPCParser:=TIDEFPCParser;
|
|
finalization
|
|
FreeAndNil(FPCMsgFilePool)
|
|
|
|
end.
|
|
|