paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 11:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: added TPascalScanner.FormatPath to allow formatting filenames in log messages

Browse Source 
git-svn-id: trunk@37350 -
This commit is contained in:
Mattias Gaertner 2017-09-28 14:48:45 +00:00
parent 3d17111e2f
commit 8fccd2aefc
2 changed files with 45 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1252,7 +1252,8 @@ type
// log and messages
class procedure UnmangleSourceLineNumber(LineNumber: integer;
out Line, Column: integer);
class function GetElementSourcePosStr(El: TPasElement): string;
class function GetDbgSourcePosStr(El: TPasElement): string;
function GetElementSourcePosStr(El: TPasElement): string;
procedure SetLastMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
Const Fmt : String; Args : Array of const; PosEl: TPasElement);
procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
@ -9869,7 +9870,7 @@ begin
end;
end;
class function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
var
Line, Column: integer;
begin
@ -9881,6 +9882,18 @@ begin
Result:=Result+')';
end;
function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
var
Line, Column: integer;
begin
if El=nil then exit('nil');
UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
if Column>0 then
Result:=Result+','+IntToStr(Column);
Result:=Result+')';
end;
destructor TPasResolver.Destroy;
begin
{$IFDEF VerbosePasResolverMem}

46
packages/fcl-passrc/src/pscanner.pp
View File

@ -505,6 +505,7 @@ type
TPScannerLogEvents = Set of TPScannerLogEvent;
TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String;
var Handled: boolean) of object;
TPScannerFormatPathEvent = function(const aPath: string): string of object;
TPascalScanner = class
private
@ -532,6 +533,7 @@ type
FOnDirective: TPScannerDirectiveEvent;
FOnEvalFunction: TCEEvalFunctionEvent;
FOnEvalVariable: TCEEvalVarEvent;
FOnFormatPath: TPScannerFormatPathEvent;
FOptions: TPOptions;
FLogEvents: TPScannerLogEvents;
FOnLog: TPScannerLogHandler;
@ -598,7 +600,8 @@ type
public
constructor Create(AFileResolver: TBaseFileResolver);
destructor Destroy; override;
procedure OpenFile(const AFilename: string);
procedure OpenFile(AFilename: string);
function FormatPath(const aFilename: string): string; virtual;
Procedure SetNonToken(aToken : TToken);
Procedure UnsetNonToken(aToken : TToken);
Procedure SetTokenOption(aOption : TTokenoption);
@ -635,13 +638,14 @@ type
property Macros: TStrings read FMacros;
property MacrosOn: boolean read FMacrosOn write FMacrosOn;
property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
property AllowedModeSwitches: TModeSwitches Read FAllowedModeSwitches Write SetAllowedModeSwitches;
property ReadOnlyModeSwitches: TModeSwitches Read FReadOnlyModeSwitches Write SetReadOnlyModeSwitches;// always set, cannot be disabled
property CurrentModeSwitches: TModeSwitches Read FCurrentModeSwitches Write SetCurrentModeSwitches;
property Options : TPOptions Read FOptions Write SetOptions;
property ForceCaret : Boolean Read GetForceCaret;
property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
property AllowedModeSwitches: TModeSwitches read FAllowedModeSwitches Write SetAllowedModeSwitches;
property ReadOnlyModeSwitches: TModeSwitches read FReadOnlyModeSwitches Write SetReadOnlyModeSwitches;// always set, cannot be disabled
property CurrentModeSwitches: TModeSwitches read FCurrentModeSwitches Write SetCurrentModeSwitches;
property Options : TPOptions read FOptions write SetOptions;
property ForceCaret : Boolean read GetForceCaret;
property LogEvents : TPScannerLogEvents read FLogEvents write FLogEvents;
property OnLog : TPScannerLogHandler read FOnLog write FOnLog;
property OnFormatPath: TPScannerFormatPathEvent read FOnFormatPath write FOnFormatPath;
property ConditionEval: TCondDirectiveEvaluator read FConditionEval;
property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
@ -2226,14 +2230,22 @@ begin
FCurtokenString:=AValue;
end;
procedure TPascalScanner.OpenFile(const AFilename: string);
procedure TPascalScanner.OpenFile(AFilename: string);
begin
Clearfiles;
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[AFileName],True);
FCurFilename := AFilename;
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(AFilename));
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
end;
function TPascalScanner.FormatPath(const aFilename: string): string;
begin
if Assigned(OnFormatPath) then
Result:=OnFormatPath(aFilename)
else
Result:=aFilename;
end;
procedure TPascalScanner.SetNonToken(aToken: TToken);
@ -2416,14 +2428,16 @@ end;
procedure TPascalScanner.Error(MsgNumber: integer; const Msg: string);
begin
SetCurMsg(mtError,MsgNumber,Msg,[]);
raise EScannerError.CreateFmt('%s(%d,%d) Error: %s',[CurFilename,CurRow,CurColumn,FLastMsg]);
raise EScannerError.CreateFmt('%s(%d,%d) Error: %s',
[FormatPath(CurFilename),CurRow,CurColumn,FLastMsg]);
end;
procedure TPascalScanner.Error(MsgNumber: integer; const Fmt: string;
Args: array of const);
begin
SetCurMsg(mtError,MsgNumber,Fmt,Args);
raise EScannerError.CreateFmt('%s(%d,%d) Error: %s',[CurFilename,CurRow,CurColumn,FLastMsg]);
raise EScannerError.CreateFmt('%s(%d,%d) Error: %s',
[FormatPath(CurFilename),CurRow,CurColumn,FLastMsg]);
end;
function TPascalScanner.DoFetchTextToken:TToken;
@ -2532,7 +2546,7 @@ begin
if FCurSourceFile is TFileLineReader then
FCurFilename := TFileLineReader(FCurSourceFile).Filename; // nicer error messages
If LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FCurFileName],True);
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(FCurFileName)],True);
end;
function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
@ -3564,7 +3578,7 @@ begin
if SkipSourceInfo then
Msg:=Msg+FLastMsg
else
Msg:=Msg+Format('%s(%d,%d) : %s',[FCurFileName,CurRow,CurColumn,FLastMsg]);
Msg:=Msg+Format('%s(%d,%d) : %s',[FormatPath(FCurFileName),CurRow,CurColumn,FLastMsg]);
FOnLog(Self,Msg);
end;
end;