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

* Merging revisions r45415 from trunk:

Browse Source 
------------------------------------------------------------------------
    r45415 | michael | 2020-05-18 10:28:14 +0200 (Mon, 18 May 2020) | 1 line
    
    * Add OnComment
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46646 -
This commit is contained in:
michael 2020-08-23 10:36:22 +00:00
parent 1b09c1ce58
commit a34187ffdc
2 changed files with 40 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -684,8 +684,8 @@ type
TPScannerLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
TPScannerLogEvent = (sleFile,sleLineNumber,sleConditionals,sleDirective);
TPScannerLogEvents = Set of TPScannerLogEvent;
TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String;
var Handled: boolean) of object;
TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String; var Handled: boolean) of object;
TPScannerCommentEvent = procedure(Sender: TObject; aComment : String) of object;
TPScannerFormatPathEvent = function(const aPath: string): string of object;
TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
@ -734,6 +734,7 @@ type
FMacros: TStrings; // Objects are TMacroDef
FDefines: TStrings;
FNonTokens: TTokens;
FOnComment: TPScannerCommentEvent;
FOnDirective: TPScannerDirectiveEvent;
FOnEvalFunction: TCEEvalFunctionEvent;
FOnEvalVariable: TCEEvalVarEvent;
@ -799,6 +800,7 @@ type
function HandleDirective(const ADirectiveText: String): TToken; virtual;
function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
procedure HandleBoolDirective(bs: TBoolSwitch; const Param: String); virtual;
procedure DoHandleComment(Sender: TObject; const aComment : string); virtual;
procedure DoHandleDirective(Sender: TObject; Directive, Param: String;
var Handled: boolean); virtual;
procedure HandleIFDEF(const AParam: String);
@ -882,7 +884,6 @@ type
property Defines: TStrings read FDefines;
property Macros: TStrings read FMacros;
property MacrosOn: boolean read GetMacrosOn write SetMacrosOn;
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;
@ -908,6 +909,9 @@ type
property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
property OnWarnDirective: TPScannerWarnEvent read FOnWarnDirective write FOnWarnDirective;
property OnModeChanged: TPScannerModeDirective read FOnModeChanged write FOnModeChanged; // set by TPasParser
property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
property OnComment: TPScannerCommentEvent read FOnComment write FOnComment;
property LastMsg: string read FLastMsg write FLastMsg;
property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
@ -4096,11 +4100,17 @@ begin
CurrentBoolSwitches:=CurrentBoolSwitches-[bs];
end;
procedure TPascalScanner.DoHandleComment(Sender: TObject; const aComment: string);
begin
if Assigned(OnComment) then
OnComment(Sender,aComment);
end;
procedure TPascalScanner.DoHandleDirective(Sender: TObject; Directive,
Param: String; var Handled: boolean);
begin
if Assigned(OnDirective) then
OnDirective(Self,Directive,Param,Handled);
OnDirective(Sender,Directive,Param,Handled);
end;
function TPascalScanner.DoFetchToken: TToken;
@ -4301,7 +4311,9 @@ begin
Inc(FTokenPos, 2);
Result := tkComment;
if Copy(CurTokenString,1,1)='$' then
Result := HandleDirective(CurTokenString);
Result := HandleDirective(CurTokenString)
else
DoHandleComment(Self,CurTokenString);
end;
end;
')':
@ -4602,7 +4614,9 @@ begin
Inc(FTokenPos);
Result := tkComment;
if (Copy(CurTokenString,1,1)='$') then
Result:=HandleDirective(CurTokenString);
Result:=HandleDirective(CurTokenString)
else
DoHandleComment(Self, CurTokenString)
end;
'A'..'Z', 'a'..'z', '_':
begin

20
packages/fcl-passrc/tests/tcscanner.pas
View File

@ -55,7 +55,10 @@ type
FLI: String;
FScanner : TPascalScanner;
FResolver : TStreamResolver;
FDoCommentCalled : Boolean;
FComment: string;
protected
procedure DoComment(Sender: TObject; aComment: String);
procedure SetUp; override;
procedure TearDown; override;
Function TokenToString(tk : TToken) : string;
@ -82,6 +85,7 @@ type
procedure TestNestedComment3;
procedure TestNestedComment4;
procedure TestNestedComment5;
procedure TestonComment;
procedure TestIdentifier;
procedure TestSelf;
procedure TestSelfNoToken;
@ -369,8 +373,15 @@ end;
TTestScanner
---------------------------------------------------------------------}
procedure TTestScanner.DoComment(Sender: TObject; aComment: String);
begin
FDoCommentCalled:=True;
FComment:=aComment;
end;
procedure TTestScanner.SetUp;
begin
FDoCommentCalled:=False;
FResolver:=TStreamResolver.Create;
FResolver.OwnsStreams:=True;
FScanner:=TTestingPascalScanner.Create(FResolver);
@ -571,6 +582,15 @@ begin
TestToken(tkComment,'(* (* comment *) *)');
end;
procedure TTestScanner.TestonComment;
begin
FScanner.OnComment:=@DoComment;
DoTestToken(tkComment,'(* abc *)',False);
assertTrue('Comment called',FDoCommentCalled);
AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
AssertEquals('Correct comment token',' abc ',FComment);
end;
procedure TTestScanner.TestIdentifier;