lazarus-6df7e8756882f7d7f28f662011ee72f21746c580/ide/etfpcmsgparser.pas

{
 ***************************************************************************
 *                                                                         *
 *   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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    Parser for Free Pascal Compiler output.
}
unit etFPCMsgParser;

{$mode objfpc}{$H+}

{ $DEFINE VerboseFPCMsgUnitNotFound}

interface

uses
  // RTL
  Classes, SysUtils, strutils, math,
  // CodeTools
  KeywordFuncLists, CodeToolsFPCMsgs, CodeCache, FileProcs, CodeToolManager,
  DirectoryCacher, BasicCodeTools, DefineTemplates, SourceLog, LinkScanner,
  // LazUtils
  LConvEncoding, LazUTF8, FileUtil, LazFileUtils, LazFileCache, LazUtilities,
  AvgLvlTree,
  // IDEIntf
  IDEExternToolIntf, PackageIntf, LazIDEIntf, ProjectIntf, MacroIntf, IDEUtils,
  // IDE
  IDECmdLine, LazarusIDEStrConsts, EnvironmentOpts, LazConf, TransferMacros,
  etMakeMsgParser;

const
  FPCMsgIDCompiling = 3104;
  FPCMsgIDLogo = 11023;
  FPCMsgIDCantFindUnitUsedBy = 10022;
  FPCMsgIDLinking = 9015;
  FPCMsgIDErrorWhileLinking = 9013;
  FPCMsgIDErrorWhileCompilingResources = 9029;
  FPCMsgIDCallingResourceCompiler = 9028;
  FPCMsgIDThereWereErrorsCompiling = 10026;
  FPCMsgIDMethodIdentifierExpected = 3047;
  FPCMsgIDIdentifierNotFound = 5000;
  FPCMsgIDChecksumChanged = 10028;
  FPCMsgIDUnitNotUsed = 5023; // Unit "$1" not used in $2
  FPCMsgIDCompilationAborted = 1018;
  FPCMsgIDLinesCompiled = 1008;

  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; virtual; // 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); virtual; // (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;
    PatternLine: integer; // line index in a multi line pattern, starting at 0
  end;
  PPatternToMsgID = ^TPatternToMsgID;

  { 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; PatternLine: integer = 0);
    procedure AddLines(const Lines: string; MsgID: integer);
    function LineToMsgID(p: PChar): integer; inline; // 0 = not found
    function LineToPattern(p: PChar): PPatternToMsgID;
    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)
    fMsgIsStdErr: boolean;
    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 CheckFollowUpMessage(p: PChar): boolean;
    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; // e.g. Free Pascal Compiler version 2.6.4 [2014/02/26] for i386
    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 CheckForLinkerErrors(p: PChar): boolean;
    function CheckForAssemblerErrors(p: PChar): boolean;
    function CheckForUnspecificStdErr(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);
    function FindSrcViaPPU(aPhase: TExtToolParserSyncPhase; MsgLine: TMessageLine;
      const PPUFilename: string): boolean;
    procedure Translate(p: PChar; MsgItem, TranslatedItem: TFPCMsgItem;
      out TranslatedMsg: String; out MsgType: TMessageLineUrgency);
    function ReverseInstantFPCCacheDir(var aFilename: string; aSynchronized: boolean): boolean;
    function ReverseTestBuildDir(MsgLine: TMessageLine; var aFilename: string): boolean;
    function LongenFilename(MsgLine: TMessageLine; aFilename: string): string; // (worker thread)
  protected
    function GetDefaultPCFullVersion: LongWord; virtual;
    function ToUTF8(const Line: string): string; virtual;
  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;
    InstantFPCCache: string; // with trailing pathdelim
    TestBuildDir: string; // with trailing pathdelim
    VirtualProjectFiles: TFilenameToPointerTree;
    PC_FullVersion: LongWord;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Init; override; // called after macros resolved, before starting thread (main thread)
    procedure InitReading; override; // called when process started, before first line (worker thread)
    procedure Done; override; // called after process stopped (worker thread)
    procedure ReadLine(Line: string; OutputIndex: integer; IsStdErr: boolean;
      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 CanParseSubTool(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;
    class function MsgFilePool: TFPCMsgFilePool; virtual;
  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;
  PatternLine: 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;
  Item.PatternLine:=PatternLine;
end;

procedure TPatternToMsgIDs.AddLines(const Lines: string; MsgID: integer);
var
  StartPos: PChar;
  p: PChar;
  PatternLine: Integer;
begin
  PatternLine:=0;
  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,PatternLine);
      inc(PatternLine);
    end;
    while p^ in [#10,#13] do inc(p);
  end;
end;

function TPatternToMsgIDs.LineToMsgID(p: PChar): integer;
var
  Item: PPatternToMsgID;
begin
  Item:=LineToPattern(p);
  if Item=nil then
    Result:=0
  else
    Result:=Item^.MsgID;
end;

function TPatternToMsgIDs.LineToPattern(p: PChar): PPatternToMsgID;
var
  i: Integer;
begin
  while p^ in [' ',#9,#10,#13] do inc(p);
  i:=IndexOf(p,false);
  if i<0 then
    Result:=nil
  else
    Result:=@fItems[i];
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
        if ExitCode=0 then
          debugln(['TFPCMsgFilePool.Destroy file still used: ',Item.Filename]);
      end;
    end;
    if FFiles.Count>0 then begin
      if ExitCode<>0 then
        exit;
      raise Exception.Create('TFPCMsgFilePool.Destroy some files are still used');
    end;
    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);
  //writeln('TFPCMsgFilePool.LoadCurrentEnglishFile ',anEnglishFile);
  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;
  CompilerKind: TPascalCompiler;
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
    FPCVer:=CodeToolBoss.CompilerDefinesCache.GetPCVersion(
              CompilerFilename,TargetOS,TargetCPU,false,CompilerKind);
    if CompilerKind<>pcFPC then
      ;// ToDo
    FPCSrcDir:=EnvironmentOptions.GetParsedFPCSourceDirectory(FPCVer);
    if FilenameIsAbsolute(FPCSrcDir) then begin
      // FPCSrcDir exists => use the errore.msg
      aFilename:=AppendPathDelim(FPCSrcDir)+GetForcedPathDelims('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)+GetForcedPathDelims('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(VirtualProjectFiles);
  FreeAndNil(FFilesToIgnoreUnitNotUsed);
  FreeAndNil(fFileExists);
  FreeAndNil(fCurSource);
  if TranslationFile<>nil then
    MsgFilePool.UnloadFile(TranslationFile);
  if MsgFile<>nil then
    MsgFilePool.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:=MsgFilePool.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;
  aProject: TLazProject;
  aProjFile: TLazProjectFile;
begin
  inherited Init;

  PC_FullVersion:=GetDefaultPCFullVersion;

  if MsgFilePool<>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;
    MsgFilePool.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 unit search path
  fUnitPathValidForWorkerDir:=Tool.WorkerDirectory;
  fUnitPath:=CodeToolBoss.GetUnitPathForDirectory(
                           ChompPathDelim(fUnitPathValidForWorkerDir));

  // get instantfpc cache directory
  InstantFPCCache:='$(InstantFPCCache)';
  if IDEMacros.SubstituteMacros(InstantFPCCache) then
    InstantFPCCache:=AppendPathDelim(InstantFPCCache)
  else
    InstantFPCCache:='';

  // get TestBuildDir
  if Tool.CurrentDirectoryIsTestDir then begin
    // source filenames in CurrentDirectory must be reversed back
    // -> store the list of virtual filenames (needed by worker thread)
    TestBuildDir:=AppendPathDelim(ResolveDots(Tool.Process.CurrentDirectory));
    if VirtualProjectFiles=nil then
      VirtualProjectFiles:=TFilenameToPointerTree.Create(true);
    aProject:=LazarusIDE.ActiveProject;
    for i:=0 to aProject.FileCount-1 do begin
      aProjFile:=aProject.Files[i];
      if aProjFile.IsPartOfProject and (not FilenameIsAbsolute(aProjFile.Filename)) then
        VirtualProjectFiles[aProjFile.Filename]:=Tool;
    end;
  end else
    TestBuildDir:='';
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;
var
  OldP: PChar;
  AFilename: string;
  aDir: String;
  MsgLine: TMessageLine;
  NewFilename: String;
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:=TrimFilename(p);
  aDir:=ExtractFilePath(AFilename);
  if aDir<>'' then begin
    // make absolute
    if (not FilenameIsAbsolute(aDir)) and (Tool.WorkerDirectory<>'') then begin
      aDir:=TrimFilename(AppendPathDelim(Tool.WorkerDirectory)+aDir);
      AFilename:=aDir+ExtractFileName(AFilename);
    end;
    // reverse instantfpc cache
    if (InstantFPCCache<>'') and (Tool.WorkerDirectory<>'')
    and (FilenameIsAbsolute(aDir))
    and (CompareFilenames(InstantFPCCache,aDir)=0) then
    begin
      NewFilename:=AppendPathDelim(Tool.WorkerDirectory)+ExtractFileName(AFilename);
      if FileExists(NewFilename,false) then begin
        AFilename:=NewFilename;
        aDir:=Tool.WorkerDirectory;
      end;
    end;
    // store directory
    if DirectoryStack=nil then DirectoryStack:=TStringList.Create;
    if (DirectoryStack.Count=0)
    or (DirectoryStack[DirectoryStack.Count-1]<>aDir) then
      DirectoryStack.Add(aDir);
  end;
  MsgLine:=CreateMsgLine;
  MsgLine.Urgency:=mluProgress;
  MsgLine.SubTool:=DefaultSubTool;
  MsgLine.Filename:=AFilename;
  MsgLine.Msg:=OldP;
  inherited AddMsgLine(MsgLine);
  Result:=true;
end;

function TIDEFPCParser.CheckForAssemblingState(p: PChar): boolean;
var
  MsgLine: TMessageLine;
  OldP: PChar;
begin
  Result:=fMsgID=9001;
  if (not Result) and (fMsgID>0) then exit;
  OldP:=p;
  if (not Result) and (not CompStr('Assembling ',p)) then exit;
  MsgLine:=CreateMsgLine;
  MsgLine.Urgency:=mluProgress;
  MsgLine.SubTool:=DefaultSubTool;
  MsgLine.Urgency:=mluProgress;
  MsgLine.Msg:=OldP;
  inherited 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
  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: ') or ReadString(p,'Warning:') 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>=1 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:=DefaultSubTool;
  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:=DefaultSubTool;
  MsgLine.Urgency:=mluProgress;
  MsgLine.Msg:=OldP;
  inherited AddMsgLine(MsgLine);
  Result:=true;
end;

function TIDEFPCParser.CheckForLinesCompiled(p: PChar): boolean;
var
  OldStart: PChar;
  MsgLine: TMessageLine;
begin
  Result:=fMsgID=FPCMsgIDLinesCompiled;
  if (not Result) and (fMsgID>0) 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;
  Result:=true;
  MsgLine:=CreateMsgLine;
  MsgLine.SubTool:=DefaultSubTool;
  if ShowLinesCompiled then
    MsgLine.Urgency:=mluImportant
  else
    MsgLine.Urgency:=mluVerbose;
  MsgLine.Msg:=OldStart;
  inherited AddMsgLine(MsgLine);
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 (not Result) and (fMsgID>0) 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:=DefaultSubTool;
  MsgLine.Urgency:=mluProgress;
  MsgLine.Msg:=OldStart;
  inherited 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.CheckForLinkerErrors(p: PChar): boolean;
const
  patUndefinedSymbol: String = 'Undefined symbols for architecture';
  patLD: String = '/usr/bin/ld: ';
var
  MsgLine: TMessageLine;
  Urgency: TMessageLineUrgency;
  s: string;
begin
  if CompareMem(PChar(patUndefinedSymbol),p,length(patUndefinedSymbol)) then
  begin
    MsgLine:=CreateMsgLine;
    MsgLine.MsgID:=0;
    MsgLine.SubTool:=SubToolFPCLinker;
    MsgLine.Urgency:=mluError;
    MsgLine.Msg:='linker: '+p;
    inherited AddMsgLine(MsgLine);
    exit(true);
  end;
  if CompareMem(PChar(patLD),p,length(patLD)) then
  begin
    MsgLine:=CreateMsgLine;
    MsgLine.MsgID:=0;
    MsgLine.SubTool:=SubToolFPCLinker;
    s:=p;
    Urgency:=mluHint;
    if fMsgIsStdErr then
    begin
      Urgency:=mluWarning;
      if (Pos('link.res',s)>0) and (Pos(' -T',s)>0) then
        // /usr/bin/ld: warning: /path/link.res contains output sections; did you forget -T?
        Urgency:=mluVerbose;
    end;
    MsgLine.Urgency:=Urgency;
    MsgLine.Msg:='linker: '+s;
    inherited AddMsgLine(MsgLine);
    exit(true);
  end;
  Result:=false;
end;

function TIDEFPCParser.CheckForAssemblerErrors(p: PChar): boolean;
// example:
//   <stdin>:227:9: error: unsupported directive '.stabs'
var
  APos: PChar;
  s: string;
  MsgLine: TMessageLine;
begin
  Result:=false;
  APos:=FindSubStrI('error: unsupported directive',p);
  if APos=nil then exit;
  Result:=true;
  MsgLine:=CreateMsgLine;
  MsgLine.SubTool:=SubToolFPCWindRes;
  MsgLine.Urgency:=mluError;
  s:=APos;
  if Pos('.stabs',s)>0 then
    s+='. Hint: Use another type of debug info.';
  MsgLine.Msg:='assembler: '+s;
  AddMsgLine(MsgLine);
end;

function TIDEFPCParser.CheckForUnspecificStdErr(p: PChar): boolean;
var
  MsgLine: TMessageLine;
begin
  if not fMsgIsStdErr then exit(false);
  Result:=true;
  MsgLine:=CreateMsgLine;
  MsgLine.SubTool:=SubToolFPC;
  MsgLine.Urgency:=mluError;
  MsgLine.Msg:=p;
  AddMsgLine(MsgLine);
end;

function TIDEFPCParser.CheckForInfos(p: PChar): boolean;

  function ReadFPCLogo(PatternItem: PPatternToMsgID;
    out FPCVersionAsInt: LongWord): boolean;
  var
    Line: string;
    Ranges: TFPCMsgRanges;
    aRange: PFPCMsgRange;
    i: SizeInt;
    aFPCFullVersion: String;
    FPCVersion: integer;
    FPCRelease: integer;
    FPCPatch: integer;
  begin
    Result:=false;
    FPCVersionAsInt:=0;
    i:=Pos('$FPCFULLVERSION',PatternItem^.Pattern);
    if i<1 then exit;
    Line:=p;
    Ranges:=nil;
    try
      ExtractFPCMsgParameters(PatternItem^.Pattern,Line,Ranges);
      if Ranges.Count>0 then begin
        // first is $FPCFULLVERSION
        aRange:=@Ranges.Ranges[0];
        aFPCFullVersion:=copy(Line,aRange^.StartPos+1,aRange^.EndPos-aRange^.StartPos);
        SplitFPCVersion(aFPCFullVersion,FPCVersion,FPCRelease,FPCPatch);
        FPCVersionAsInt:=FPCVersion*10000+FPCRelease*100+FPCPatch;
        Result:=FPCVersionAsInt>0;
      end;
      // second is $FPCDATE
      // third is $FPCCPU
    finally
      Ranges.Free;
    end;
  end;

var
  MsgItem: TFPCMsgItem;
  MsgLine: TMessageLine;
  MsgType: TMessageLineUrgency;
  PatternItem: PPatternToMsgID;
  aFPCVersion: LongWord;
begin
  Result:=false;
  PatternItem:=fLineToMsgID.LineToPattern(p);
  if PatternItem=nil then exit;
  fMsgID:=PatternItem^.MsgID;
  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:=DefaultSubTool;
  MsgLine.Urgency:=MsgType;
  if (fMsgID=FPCMsgIDLogo) and ReadFPCLogo(PatternItem,aFPCVersion) then begin
    if aFPCVersion<>PC_FullVersion then begin
      // unexpected FPC version => always show
      MsgLine.Urgency:=mluImportant;
      PC_FullVersion:=aFPCVersion;
    end;
  end;
  AddMsgLine(MsgLine);
end;

function TIDEFPCParser.CreateMsgLine: TMessageLine;
begin
  Result:=inherited CreateMsgLine(fOutputIndex);
  Result.MsgID:=fMsgID;
  if fMsgIsStdErr then
    Result.Flags:=Result.Flags+[mlfStdErr];
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
  Note: this comes in stderr, so it might be some lines after corresponding stdout

  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

  Linking IDE:
  (9015) Linking ../lazarus
  /usr/bin/ld: cannot find -lGL
  make[2]: *** [lazarus] Error 1
  make[1]: *** [idepkg] Error 2
  make: *** [idepkg] Error 2
  /home/mattias/pascal/wichtig/lazarus/ide/lazarus.pp(161,1) Error: (9013) Error while linking

}
var
  i: Integer;
  MsgLine: TMessageLine;
begin
  // change all low urgency messages in front of the last message to Important
  i:=Tool.WorkerMessages.Count-1;
  while i>=0 do begin
    MsgLine:=Tool.WorkerMessages[i];
    //debugln(['TIDEFPCParser.AddLinkingMessages ',i,' ',dbgs(MsgLine.Urgency),' ',MsgLine.Msg]);
    if MsgLine.Urgency<mluHint then
      MsgLine.Urgency:=mluImportant
    else
      break;
    dec(i);
  end;

  // add all skipped lines in front of the linking error
  i:=Tool.WorkerMessages.Count-1;
  if i<0 then exit;
  MsgLine:=Tool.WorkerMessages[i];
  //debugln(['TIDEFPCParser.AddLinkingMessages MsgLine.OutputIndex=',MsgLine.OutputIndex,' fOutputIndex=',fOutputIndex]);
  for i:=MsgLine.OutputIndex+1 to fOutputIndex-1 do begin
    MsgLine:=inherited CreateMsgLine(i);
    MsgLine.MsgID:=0;
    MsgLine.SubTool:=SubToolFPCLinker;
    if MsgLine.Msg<>'' then
      MsgLine.Urgency:=mluImportant
    else
      MsgLine.Urgency:=mluVerbose2;
    inherited 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 "Calling resource compiler ..."
  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;
    if MsgLine.Msg<>'' then
      MsgLine.Urgency:=mluHint
    else
      MsgLine.Urgency:=mluVerbose2;
    inherited 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<>DefaultSubTool 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-}

  function IsH(p: PChar): boolean; inline;
  begin
    Result:=(p^='{') and (p[1]='%') and (p[2]='H') and (p[3]='-');
  end;

var
  p: PChar;
  X: Integer;
  Y: Integer;
  HasDirective: Boolean;
  AbsPos: Integer; // 0-based
  OtherPos: Integer;
  AtomEnd: 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
    HasDirective:=false;
    AbsPos:=fCurSource.GetLineStart(y-1)+x-2; // 0-based
    p:=PChar(fCurSource.Source)+AbsPos;
    //debugln(['TFPCParser.ImproveMsgHiddenByIDEDirective ',MsgLine.Filename,' ',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 IsH(p) then
      // directive beginning at cursor
      HasDirective:=true
    else if (x>5) and IsH(p-5) then
      // directive ending at cursor
      HasDirective:=true
    else begin
      // different compiler versions report some message positions differently.
      // They changed some message positions from start to end of token.
      // => check other end of token
      //debugln(['TIDEFPCParser.ImproveMsgHiddenByIDEDirective mlfLeftToken=',mlfLeftToken in MsgLine.Flags]);
      if mlfLeftToken in MsgLine.Flags then begin
        if IsIdentChar[p[-1]] then begin
          OtherPos:=AbsPos+1;
          ReadPriorPascalAtom(fCurSource.Source,OtherPos,AtomEnd);
          if (OtherPos>5) and (AtomEnd=AbsPos+1)
          and IsH(@fCurSource.Source[OtherPos-5]) then begin
            // for example: {%H-}identifier|
            HasDirective:=true;
          end;
        end;
      end else begin
        if IsIdentStartChar[p^] then begin
          inc(p,GetIdentLen(p));
          if IsH(p) then
            // for example: |identifier{%H-}
            HasDirective:=true;
        end;
      end;
    end;
    if HasDirective then begin
      MsgLine.Flags:=MsgLine.Flags+[mlfHiddenByIDEDirective,
        mlfHiddenByIDEDirectiveValid];
      exit;
    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'
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 then begin
    if FilenameExtIs(MsgLine.Filename, 'lpr', true) then
      // a lpr does not use a unit => not important
      MsgLine.Urgency:=mluVerbose
    else if FilenameIsAbsolute(MsgLine.Filename)
    and FileExists(ChangeFileExt(MsgLine.Filename, '.lpk'), aPhase=etpspSynchronized)
    then begin
      // a lpk does not use a unit => not important
      MsgLine.Urgency:=mluVerbose;
    end;
  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; OnlyInstalled: boolean;
    out Pkg: TIDEPackage; out PkgName: string; out PkgFile: TLazPackageFile);
  var
    i: Integer;
    j: Integer;
    aFile: TLazPackageFile;
    CurPkg: TIDEPackage;
  begin
    PkgName:='';
    PkgFile:=nil;
    Pkg:=nil;
    // search unit in packages
    for i:=0 to PackageEditingInterface.GetPackageCount-1 do begin
      CurPkg:=PackageEditingInterface.GetPackages(i);
      if OnlyInstalled and (CurPkg.AutoInstall=pitNope) then
        continue;
      if CompareTextCT(CurPkg.Name,MissingUnitname)=0 then begin
        PkgName:=CurPkg.Name;
        Pkg:=CurPkg;
        break;
      end;
      for j:=0 to CurPkg.FileCount-1 do begin
        aFile:=CurPkg.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:=CurPkg.Name;
          Pkg:=CurPkg;
        end;
      end;
    end;
  end;

var
  MissingUnitName: string;
  UsedByUnit: string;
  Filename: String;
  NewFilename: String;
  CodeBuf: TCodeBuffer;
  Owners: TFPList;
  UsedByOwner: TObject;
  UsedByPkg: TIDEPackage;
  PPUFilename: String;
  OnlyInstalled: Boolean;
  s: String;
  PPUFiles: TStringList; // Strings:PPUFilename, Objects:TIDEPackage
  i: Integer;
  DepOwner: TObject;
  TheOwner: TObject;
  MissingPkg: TIDEPackage;
  MissingPkgName: String;
  MissingPkgFile: TLazPackageFile;
  FPCUnitFilename: String;
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;

  // in main thread

  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
      TheOwner:=nil;
      if Tool.Data is TIDEExternalToolData then begin
        TheOwner:=ExternalToolList.GetIDEObject(TIDEExternalToolData(Tool.Data));
      end else if Tool.Data=nil then begin
        {$IFDEF VerboseFPCMsgUnitNotFound}
        debugln(['TIDEFPCParser.ImproveMsgUnitNotFound Tool.Data=nil, ProcDir=',Tool.Process.CurrentDirectory]);
        {$ENDIF}
      end;
      NewFilename:=LazarusIDE.FindUnitFile(UsedByUnit,TheOwner);
      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) or (mlfTestBuildFile in MsgLine.Flags) 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;
    UsedByPkg:=nil;
    if CodeBuf<>nil then begin
      FixSourcePos(CodeBuf,MissingUnitname);
      Owners:=PackageEditingInterface.GetOwnersOfUnit(CodeBuf.Filename);
      if (Owners<>nil) and (Owners.Count>0) then begin
        UsedByOwner:=TObject(Owners[0]);
        if UsedByOwner is TIDEPackage then
          UsedByPkg:=TIDEPackage(UsedByOwner);
      end;
    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);
      if (PPUFilename<>'') then begin
        FPCUnitFilename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitSet(
          ExtractFilePath(CodeBuf.Filename),MissingUnitName);
      end else
        FPCUnitFilename:='';
      {$IFDEF VerboseFPCMsgUnitNotFound}
      debugln(['TIDEFPCParser.ImproveMsgUnitNotFound 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);
      {$IFDEF VerboseFPCMsgUnitNotFound}
      debugln(['TIDEFPCParser.ImproveMsgUnitNotFound PPUFiles in PPU path=',PPUFiles.Count]);
      {$ENDIF}
      FindPackage(MissingUnitname,OnlyInstalled,MissingPkg,MissingPkgName,MissingPkgFile);
      {$IFDEF VerboseFPCMsgUnitNotFound}
      debugln(['TIDEFPCParser.ImproveMsgUnitNotFound MissingUnitPkg=',MissingPkgName]);
      {$ENDIF}
      s:=Format(lisCannotFind, [MissingUnitname]);
      if UsedByUnit<>'' then
        s+=Format(lisUsedBy, [UsedByUnit]);
      if PPUFiles.Count>0 then begin
        // there is a ppu file in a package output directory, but the compiler
        // didn't like it => change message
        if PPUFilename='' then
          PPUFilename:=PPUFiles[0];
        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 if PPUFilename<>'' then begin
        if CompareFilenames(PPUFilename,FPCUnitFilename)=0 then begin
          // there is ppu in the FPC units, but the compiler does not like it
          // => a) using a wrong compiler version (wrong fpc.cfg)
          //    b) user units in fpc.cfg
          //    c) fpc units not compiled with -Ur
          //    d) wrong target platform
          s+=', ppu='+PPUFilename+', check your fpc.cfg';
        end else begin
          // there is a ppu file in the source path
          if (MissingPkg<>nil) and (MissingPkg.LazCompilerOptions.UnitOutputDirectory='')
          then
            s+='. '+lisPackageNeedsAnOutputDirectory
          else
            s+='. '+lisMakeSureAllPpuFilesOfAPackageAreInItsOutputDirecto;
          s+=' '+Format(lisPpuInWrongDirectory, [PPUFilename]);
          if MissingPkgName<>'' then
            s+=' '+Format(lisCleanUpPackage, [MissingPkgName]);
          s+='.';
        end;
      end
      else if (UsedByPkg<>nil) and (CompareTextCT(UsedByPkg.Name,MissingPkgName)=0)
      then begin
        // two units of a package cannot find each other
        s+=Format(lisCheckSearchPathPackageTryACleanRebuildCheckImpleme, [
          UsedByPkg.Name]);
        s+='.';
      end else if (MissingPkgName<>'')
      and (OnlyInstalled
        or ((UsedByOwner<>nil)
           and PackageEditingInterface.IsOwnerDependingOnPkg(UsedByOwner,MissingPkgName,DepOwner)))
      then begin
        // ppu file of an used package is missing
        if (MissingPkgFile<>nil) and (not MissingPkgFile.InUses) then
          s+=Format(lisEnableFlagUseUnitOfUnitInPackage, [MissingUnitName, MissingPkgName])
        else
          s+=Format(lisCheckIfPackageCreatesPpuCheckNothingDeletesThisFil, [
            MissingPkgName, MissingUnitName]);
        s+='.';
      end else begin
        if MissingPkgName<>'' then
          s+=Format(lisCheckIfPackageIsInTheDependencies, [MissingPkgName]);
        if UsedByOwner is TLazProject then
          s+=lisOfTheProjectInspector
        else if UsedByPkg<>nil then
          s+=Format(lisOfPackage, [UsedByPkg.Name]);
        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 sometimes reports 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;
  NewP: Integer;
begin
  Col:=MsgLine.Column;
  Line:=MsgLine.Line;
  if (Col<1) or (Line<1) then
    exit;
  if (Line=1) and (Col=1) then exit;
  if MsgLine.SubTool<>SubToolFPC then exit;
  if MsgLine.MsgID=0 then begin
    // maybe not compiled with -vq: search patterns of common messages
    if (not IsMsgID(MsgLine,FPCMsgIDIdentifierNotFound,fMsgItemIdentifierNotFound))
    and (not IsMsgID(MsgLine,FPCMsgIDMethodIdentifierExpected,fMsgItemMethodIdentifierExpected))
    then
      exit;
  end;
  if MsgLine.MsgID=FPCMsgIDMethodIdentifierExpected then
    Identifier:=''
  else begin
    Identifier:=GetFPCMsgValue1(MsgLine);
    if not IsValidIdent(Identifier) then exit;
  end;

  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;
  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 start of the 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]);
  NewP:=p;
  ReadPriorPascalAtom(Src,NewP,AtomEnd,false);
  if NewP<1 then exit;
  if Identifier<>'' then begin
    // message is about a specific identifier
    if CompareIdentifiers(PChar(Identifier),@Src[NewP])<>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[NewP]] then begin
      // the prior token is not an identifier neither
      // => don't know
      exit;
    end;
  end;
  fCurSource.AbsoluteToLineCol(NewP,Line,Col);
  //DebuglnThreadLog(['New Line=',Line,' Col=',Col,' p=',NewP]);
  if (Line<1) or (Col<1) then exit;
  if MsgLine.Urgency>=mluError then begin
    // position errors at start of wrong identifier, nicer for identifier completion
    MsgLine.SetSourcePosition(MsgLine.Filename,Line,Col);
    MsgLine.Flags:=MsgLine.Flags-[mlfLeftToken];
  end else begin
    // position hints at end of identifier, nicer for {%H-}
    MsgLine.SetSourcePosition(MsgLine.Filename,Line,Col+length(Identifier));
    MsgLine.Flags:=MsgLine.Flags+[mlfLeftToken];
  end;
end;

function TIDEFPCParser.FindSrcViaPPU(aPhase: TExtToolParserSyncPhase;
  MsgLine: TMessageLine; const PPUFilename: string): boolean;
{ in main thread
 for example:
   /usr/lib/fpc/3.1.1/units/x86_64-linux/rtl/sysutils.ppu:filutil.inc(481,10) Error: (5088) ...
   PPUFilename=/usr/lib/fpc/3.1.1/units/x86_64-linux/rtl/sysutils.ppu
   Filename=filutil.inc
}
var
  i: Integer;
  PrevMsgLine: TMessageLine;
  aFilename: String;
  MsgWorkerDir: String;
  UnitSrcFilename: String;
  IncPath: String;
  Dir: String;
  ShortFilename: String;
  IncFilename: String;
  AnUnitName: String;
  InFilename: String;
begin
  case aPhase of
  etpspAfterReadLine: exit(false);
  etpspSynchronized: ;
  etpspAfterSync: exit(true);
  end;
  Result:=true;

  // in main thread
  i:=MsgLine.Index;
  aFilename:=MsgLine.Filename;
  //debugln(['TIDEFPCParser.FindSrcViaPPU i=',i,' PPUFilename="',PPUFilename,'" Filename="',aFilename,'"']);
  if (i>0) then begin
    PrevMsgLine:=Tool.WorkerMessages[i-1];
    if (PrevMsgLine.SubTool=DefaultSubTool)
    and (CompareFilenames(PPUFilename,PrevMsgLine.Attribute['PPU'])=0)
    and FilenameIsAbsolute(PrevMsgLine.Filename)
    and (CompareFilenames(ExtractFilename(PrevMsgLine.Filename),ExtractFilename(aFilename))=0)
    then begin
      // same file as previous message => use it
      MsgLine.Filename:=PrevMsgLine.Filename;
      exit;
    end;
  end;

  if not FilenameIsAbsolute(PPUFilename) then
  begin
    exit;
  end;

  ShortFilename:=ExtractFilename(aFilename);
  MsgWorkerDir:=MsgLine.Attribute[FPCMsgAttrWorkerDirectory];
  AnUnitName:=ExtractFilenameOnly(PPUFilename);
  InFilename:='';
  UnitSrcFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
                              MsgWorkerDir,AnUnitName,InFilename);
  //debugln(['TIDEFPCParser.FindSrcViaPPU MsgWorkerDir="',MsgWorkerDir,'" UnitSrcFilename="',UnitSrcFilename,'"']);
  if UnitSrcFilename<>'' then begin
    if CompareFilenames(ExtractFilename(UnitSrcFilename),ShortFilename)=0 then
    begin
      MsgLine.Filename:=UnitSrcFilename;
      exit;
    end;
    Dir:=ChompPathDelim(TrimFilename(ExtractFilePath(UnitSrcFilename)));
    IncPath:=CodeToolBoss.GetIncludePathForDirectory(Dir);
    IncFilename:=SearchFileInPath(ShortFilename,Dir,IncPath,';',ctsfcDefault);
    //debugln(['TIDEFPCParser.FindSrcViaPPU Dir="',Dir,'" IncPath="',IncPath,'" ShortFilename="',ShortFilename,'" IncFilename="',IncFilename,'"']);
    if IncFilename<>'' then begin
      MsgLine.Filename:=IncFilename;
      exit;
    end;
  end;
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;
      UTF8FixBroken(TranslatedMsg);
    end
    else if MsgItem<>nil then
      TranslatedMsg:=TranslateFPCMsg(p,MsgItem.Pattern,TranslatedItem.Pattern);
    //debugln(['TFPCParser.Translate Translation="',TranslatedMsg,'"']);
  end;
end;

function TIDEFPCParser.ReverseInstantFPCCacheDir(var aFilename: string;
  aSynchronized: boolean): boolean;
var
  Reversed: String;
begin
  Result:=false;
  if (InstantFPCCache='') then exit;
  if (CompareFilenames(ExtractFilePath(aFilename),InstantFPCCache)=0) then begin
    Reversed:=AppendPathDelim(Tool.WorkerDirectory)+ExtractFilename(aFilename);
    if FileExists(Reversed,aSynchronized) then begin
      aFilename:=Reversed;
      Result:=true;
    end;
  end;
end;

function TIDEFPCParser.ReverseTestBuildDir(MsgLine: TMessageLine;
  var aFilename: string): boolean;
var
  Reversed: String;
  l: Integer;
begin
  Result:=false;
  if not Tool.CurrentDirectoryIsTestDir then exit;
  l:=length(TestBuildDir); // Note: TestBuildDir includes trailing PathDelim
  if (length(aFilename)>l) and (aFilename[l]=PathDelim)
  and (CompareFilenames(LeftStr(aFilename,l),TestBuildDir)=0) then begin
    Reversed:=copy(aFilename,l+1,length(aFilename));
    if VirtualProjectFiles.Contains(Reversed) then begin
      MsgLine.Flags:=MsgLine.Flags+[mlfTestBuildFile];
      MsgLine.Attribute[MsgAttrDiskFilename]:=aFilename;
      aFilename:=Reversed;
      Result:=true;
    end
  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;
  PC_FullVersion:=GetCompiledFPCVersion;
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;
  MsgUrgency: 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,MsgUrgency);
  Msg:=p;
  case fMsgID of
  FPCMsgIDThereWereErrorsCompiling: // There were $1 errors compiling module, stopping
    MsgUrgency:=mluVerbose;
  FPCMsgIDLinesCompiled: // n lines compiled, m sec
    if ShowLinesCompiled then MsgUrgency:=mluImportant;
  end;
  MsgLine:=CreateMsgLine;
  MsgLine.SubTool:=DefaultSubTool;
  MsgLine.Urgency:=MsgUrgency;
  MsgLine.Msg:=Msg;
  MsgLine.TranslatedMsg:=TranslatedMsg;
  AddMsgLine(MsgLine);
end;

function TIDEFPCParser.CheckFollowUpMessage(p: PChar): boolean;
var
  i: Integer;
  LastMsgLine, MsgLine: TMessageLine;
begin
  Result:=false;
  if (p^=' ') then begin
    i:=Tool.WorkerMessages.Count-1;
    if i<0 then exit;
    LastMsgLine:=Tool.WorkerMessages[i];
    if LastMsgLine.SubTool=SubToolFPCLinker then begin
      // a follow up line of the linker output
      Result:=true;
      MsgLine:=CreateMsgLine;
      MsgLine.MsgID:=0;
      MsgLine.SubTool:=SubToolFPCLinker;
      MsgLine.Urgency:=LastMsgLine.Urgency;
      MsgLine.Msg:='linker: '+p;
      inherited AddMsgLine(MsgLine);
    end;
  end;
end;

function TIDEFPCParser.CheckForFileLineColMessage(p: PChar): boolean;
{ filename(line,column) Hint: message
  filename(line,column) Hint: (msgid) message
  filename(line) Hint: (msgid) message
  B:\file(3)name(line,column) Hint: (msgid) message
  /usr/lib/fpc/3.1.1/units/x86_64-linux/rtl/sysutils.ppu:filutil.inc(481,10) Error: (5088) ...
}
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;
  PPUFileStartPos: PChar;
  PPUFileEndPos: PChar;
begin
  Result:=false;
  FileStartPos:=p;
  FileEndPos:=nil;
  PPUFileStartPos:=nil;
  PPUFileEndPos:=nil;
  // search colon and last ( in front of colon
  while true do begin
    case p^ of
    #0: exit;
    '(': FileEndPos:=p;
    ':':
      if (p-FileStartPos>5) and (p[-4]='.') and (p[-3] in ['p','P'])
      and (p[-2] in ['p','P']) and (p[-1] in ['u','U']) then begin
        // e.g. /usr/lib/fpc/3.1.1/units/x86_64-linux/rtl/sysutils.ppu:filutil.inc(481,10) Error: (5088) ...
        if PPUFileStartPos<>nil then exit;
        PPUFileStartPos:=FileStartPos;
        PPUFileEndPos:=p;
        FileStartPos:=p+1;
      end
      else if (DriveSeparator='') or (p-FileStartPos>1) then
        break;
    end;
    inc(p);
  end;
  if (FileEndPos=nil) or (FileEndPos-FileStartPos=0) or (FileEndPos[-1]=' ') then exit;
  p:=FileEndPos;
  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,'Info:') then begin
    MsgType:=mluVerbose;
  end else if ReadString(p,'Hint:') then begin
    MsgType:=mluHint;
  end else if ReadString(p,'Note:') then begin
    MsgType:=mluNote;
  end else if ReadString(p,'Warn:') or ReadString(p,'Warning: ') 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);
        if (TranslatedItem=nil) and (MsgItem=nil) then begin
          if ConsoleVerbosity>=1 then
            debugln(['TFPCParser.CheckForFileLineColMessage msgid not found: ',fMsgID]);
        end else begin
          Translate(p,MsgItem,TranslatedItem,TranslatedMsg,MsgType);
          if MsgType=mluNone then begin
            if ConsoleVerbosity>=1 then
              debugln(['TFPCParser.CheckForFileLineColMessage msgid has no type: ',fMsgID]);
          end;
        end;
      end;
    end;
  end;
  if ColStartPos<>nil then
    Column:=Str2Integer(ColStartPos,0)
  else
    Column:=0;

  MsgLine:=CreateMsgLine;
  MsgLine.SubTool:=DefaultSubTool;
  MsgLine.Urgency:=MsgType;
  aFilename:=GetString(FileStartPos,FileEndPos-FileStartPos);
  if PPUFileStartPos<>nil then
    MsgLine.Attribute['PPU']:=GetString(PPUFileStartPos,PPUFileEndPos-PPUFileStartPos);
  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 (not Result) and (fMsgID>0) 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:=DefaultSubTool;
  MsgLine.Urgency:=mluProgress;
  MsgLine.Msg:=OldP;
  AddMsgLine(MsgLine);
  Result:=true;
end;

procedure TIDEFPCParser.ReadLine(Line: string; OutputIndex: integer;
  IsStdErr: boolean; 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;
  Line:=ToUTF8(Line);
  p:=PChar(Line);
  fOutputIndex:=OutputIndex;
  fMsgID:=0;
  fMsgIsStdErr:=IsStdErr;

  // 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^=' ' do inc(p);
  end;

  if p^ in [#0..#31,' '] then begin
    CheckFollowUpMessage(p);
    exit; // not a fpc message
  end;

  Handled:=true;

  //debugln(['TIDEFPCParser.ReadLine ',IsStdErr,' ',Line]);

  // 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;
  // check for linker errors
  if CheckForLinkerErrors(p) then exit;
  // check for assembler errors
  if CheckForAssemblerErrors(p) then exit;

  // last: check for unknown std error
  if CheckForUnspecificStdErr(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:=MsgLine.Msg+' -> '+'Compile with -vd for more details. Check for duplicates.';
    MsgLine.TranslatedMsg:=MsgLine.TranslatedMsg+' -> '+lisCompileWithVdForMoreDetailsCheckForDuplicates;
  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 begin
    if ReverseInstantFPCCacheDir(Result,false) then exit;
    if ReverseTestBuildDir(MsgLine,Result) then exit;
    exit;
  end;
  if MsgLine.Attribute['PPU']<>'' then begin
    MsgLine.Attribute[FPCMsgAttrWorkerDirectory]:=Tool.WorkerDirectory;
    exit;
  end;

  ShortFilename:=Result;
  // check last message line
  LastMsgLine:=Tool.WorkerMessages.GetLastLine;
  if (LastMsgLine<>nil) then begin
    if mlfTestBuildFile in LastMsgLine.Flags then
      LastFilename:=LastMsgLine.Attribute[MsgAttrDiskFilename]
    else
      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
        if mlfTestBuildFile in LastMsgLine.Flags then begin
          MsgLine.Attribute[MsgAttrDiskFilename]:=LastFilename;
          MsgLine.Flags:=MsgLine.Flags+[mlfTestBuildFile];
          Result:=LastMsgLine.Filename;
        end else begin
          Result:=LastFilename;
          ReverseTestBuildDir(MsgLine,Result);
        end;
        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 begin
        ReverseTestBuildDir(MsgLine,Result);
        exit;
      end;
    end;
  end;
  // search file in worker directory
  if Tool.WorkerDirectory<>'' then begin
    Result:=AppendPathDelim(Tool.WorkerDirectory)+ShortFilename;
    if FileExists(Result,false) then begin
      ReverseTestBuildDir(MsgLine,Result);
      exit;
    end;
  end;

  // file not found
  Result:=ShortFilename;

  // save Tool.WorkerDirectory for ImproveMessage
  MsgLine.Attribute[FPCMsgAttrWorkerDirectory]:=Tool.WorkerDirectory;
end;

function TIDEFPCParser.GetDefaultPCFullVersion: LongWord;
var
  Kind: TPascalCompiler;
begin
  // get compiler version
  Result:=LongWord(CodeToolBoss.GetPCVersionForDirectory(Tool.WorkerDirectory,Kind));
  if Kind=pcFPC then ;
end;

function TIDEFPCParser.ToUTF8(const Line: string): string;
begin
  if PC_FullVersion>=20701 then
    Result:=ConsoleToUTF8(Line)
  else begin
    {$IFDEF MSWINDOWS}
    Result:=WinCPToUTF8(Line);
    {$ELSE}
    Result:=SysToUTF8(Line);
    {$ENDIF}
  end;
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;
  PPUFilename: 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=DefaultSubTool) and (MsgLine.Filename<>'')
    then begin
      if mlfTestBuildFile in MsgLine.Flags then
        aFilename:=MsgLine.Attribute[MsgAttrDiskFilename]
      else
        aFilename:=MsgLine.Filename;
      PPUFilename:='';
      if (not FilenameIsAbsolute(aFilename)) then begin
        PPUFilename:=MsgLine.Attribute['PPU'];
        if PPUFilename<>'' then begin
          // compiler gave ppu file and relative source file
          if not FindSrcViaPPU(aPhase,MsgLine,PPUFilename) then continue;
        end;
      end;
      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=DefaultSubTool)
          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:=FileUtil.SearchFileInPath(aFilename,MsgWorkerDir,fIncludePath,';',
                                 [FileUtil.sffSearchLoUpCase,sffFile]);
          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) or (mlfTestBuildFile in MsgLine.Flags)
      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;

      ImproveMsgIdentifierPosition(aPhase, MsgLine, SourceOK);
      ImproveMsgHiddenByIDEDirective(aPhase, MsgLine, SourceOK);
      ImproveMsgUnitNotUsed(aPhase, MsgLine);
      ImproveMsgSenderNotUsed(aPhase, MsgLine);
    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.CanParseSubTool(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,DefaultSubTool)=0 then begin
    CurMsgFile:=MsgFilePool.LoadCurrentEnglishFile(false,nil);
    if CurMsgFile=nil then exit;
    try
      MsgItem:=CurMsgFile.GetMsg(MsgID);
      if MsgItem=nil then exit;
      Result:=MsgItem.GetTrimmedComment(false,true);
    finally
      MsgFilePool.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,DefaultSubTool)=0 then begin
    if MsgFilePool=nil then exit;
    CurMsgFile:=MsgFilePool.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
      MsgFilePool.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<>DefaultSubTool 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<>DefaultSubTool 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<>DefaultSubTool then exit;
  Result:=etFPCMsgParser.GetFPCMsgValues2(Msg.Msg,GetFPCMsgPattern(Msg),Value1,Value2);
end;

class function TIDEFPCParser.MsgFilePool: TFPCMsgFilePool;
begin
  Result:=FPCMsgFilePool;
end;

initialization
  IDEFPCParser:=TIDEFPCParser;
finalization
  FreeAndNil(FPCMsgFilePool);

end.