Add Pascal/Delphi for Function List

Add Pascal/Delphi FunctionList parser and unit tests.

Fix #3664, close #12489
pull/12519/head
dinkumoil 2 years ago committed by Don Ho
parent bc1487881a
commit 87a53d1ed2

@ -0,0 +1,445 @@
unit Test;
interface
uses
System.SysUtils, System.Types, System.Classes;
// ATTENTION!!! This is a known issue!
// The following function should NOT be part of the function list tree.
// However, it is still included because of the TYPE keyword after its declaration.
// Global functions or procedures should therefor be declared immediately before
// the keyword IMPLEMENTATION.
function FreeFunc(const Param: integer): integer;
type
// -----------------------------------------------------------------------------
// TStdClass
// -----------------------------------------------------------------------------
TStdClass = class(TObject)
private type
TStdInternalClass = class(TObject)
private
FName: string;
FId: integer;
public
constructor Create;
destructor Destroy; override;
procedure CopyTo(Dest: TStdInternalClass);
property Name: string read FName write FName;
property Id: integer read FId write FId;
end;
private
FId: integer;
FValue: string;
class var FInstCnt: integer;
class function Init(Cnt: integer): boolean;
class function DeInit(Cnt: integer): boolean;
procedure SetValue(const Value: string);
public
constructor Create;
destructor Destroy; override;
function Convert<X: class, constructor>(const Value: string): X;
class property InstCnt: integer read FInstCnt;
property PropId: integer read FId write FId;
property PropValue: string read FValue write SetValue;
end;
// -----------------------------------------------------------------------------
// TGenericClass<T>
// -----------------------------------------------------------------------------
TGenericClass<T> = class(TObject)
private type
TGenericInternalClass<T, I> = class(TObject)
strict private
FName: string;
FId: T;
FValue: I;
public
constructor Create;
destructor Destroy; override;
procedure CopyTo<I>(Dest: TGenericInternalClass<T, I>);
property Name: string read FName write FName;
property Id: T read FId write FId;
property Value: I read FValue write FValue;
end;
strict private
FId: integer;
FValue: T;
class var FInstCnt: integer;
class function Init<I>(Cnt: integer): boolean;
class function DeInit(Cnt: integer): boolean;
procedure SetValue(const Value: T);
public
constructor Create;
destructor Destroy; override;
class property InstCnt: integer read FInstCnt;
property PropId: integer read FId write FId;
property PropValue: T read FValue write SetValue;
end;
type
// -----------------------------------------------------------------------------
// TEnum
// -----------------------------------------------------------------------------
TEnum = (enMember1, enMember2, enMember3);
TEnumHelper = record helper for TEnum
public
function ToString: string;
class function FromString(const AString: string): TEnum; static;
end;
// -----------------------------------------------------------------------------
// TStdClassHelper
// -----------------------------------------------------------------------------
TStdClassHelper = class helper for TStdClass
public
function AsString: string;
class function FromString(const AString: string): TStdClass; static;
end;
// -----------------------------------------------------------------------------
// Free routines
// -----------------------------------------------------------------------------
function FreeFunc2(const Param: integer): integer;
implementation
{R *.dfm}
// -----------------------------------------------------------------------------
// Free routines
// -----------------------------------------------------------------------------
{ Free function 3 }
function FreeFunc3(const Param: integer): integer; forward;
{ Free function 1 }
function FreeFunc(const Param: integer): integer;
begin
//
end;
{ Free function 4 }
procedure FreeFunc4(const Param: integer); forward;
// -----------------------------------------------------------------------------
// TStdClass
// -----------------------------------------------------------------------------
constructor TStdClass.Create;
begin
inherited;
Init(Succ(InstCnt));
end;
destructor TStdClass.Destroy;
begin
DeInit(Pred(InstCnt));
inherited;
end;
class function TStdClass.Init(Cnt: integer): boolean;
begin
FInstCnt := Cnt;
end;
class function TStdClass.DeInit(Cnt: integer): boolean;
begin
FInstCnt := Cnt;
end;
procedure TStdClass.SetValue(const Value: string);
begin
FValue := Value;
end;
function TStdClass.Convert<X>(const Value: string): X;
begin
Result := ToType<X>(Value);
end;
// -----------------------------------------------------------------------------
// TStdClass.TStdInternalClass
// -----------------------------------------------------------------------------
constructor TStdClass.TStdInternalClass.Create;
begin
inherited;
//
end;
destructor TStdClass.TStdInternalClass.Destroy;
begin
//
inherited;
end;
procedure TStdClass.TStdInternalClass.CopyTo(Dest: TStdInternalClass);
begin
Dest.Name := Name;
Dest.Id := Id;
end;
// -----------------------------------------------------------------------------
// Free routines
// -----------------------------------------------------------------------------
{ Free function 2 with internal function preceeded by a comment }
function FreeFunc2(const Param: integer): integer;
// Internal routine
function FreeFunc2Internal: integer;
begin
//
end;
begin
//
end;
{ Free function 3 with internal procedure }
function FreeFunc3: integer;
procedure FreeFunc3Internal(const Param: integer);
begin
//
end;
begin
//
end;
{ Free procedure 4 with internal function }
procedure FreeFunc4;
function FreeFunc4Internal(const Param: integer): string;
begin
//
end;
begin
//
end;
{ Free procedure 5 with internal procedure preceeded by a comment }
procedure FreeFunc5;
// Internal routine
procedure FreeFunc5Internal;
begin
//
end;
begin
//
end;
// -----------------------------------------------------------------------------
// TGenericClass<T>
// -----------------------------------------------------------------------------
constructor TGenericClass<T>.Create;
begin
inherited;
Init<string>(Succ(InstCnt));
end;
destructor TGenericClass<T>.Destroy;
begin
DeInit(Pred(InstCnt));
inherited;
end;
// This is a class function
class function TGenericClass<T>.Init<I>(Cnt: integer): boolean;
// ---------------------------------------------------------------------------
// This is an inline function with surrounding comments
function InitStdInternalClass: integer;
begin
//
end;
// ---------------------------------------------------------------------------
function ReInitStdInternalClass: integer;
begin
// This is an inline function without surrounding comments
end;
// This is the main function's body
begin
FInstCnt := Cnt;
end;
// This is a class function
class function TGenericClass<T>.DeInit(Cnt: integer): boolean;
begin
FInstCnt := Cnt;
end;
procedure TGenericClass<T>.SetValue(const Value: T);
begin
FValue := Value;
end;
// -----------------------------------------------------------------------------
// TGenericClass<T>.TGenericInternalClass<T, I>
// -----------------------------------------------------------------------------
constructor TGenericClass<T>.TGenericInternalClass<T, I>.Create;
begin
inherited;
FValue := '';
FId := Default(T);
FName := Default(I);
end;
destructor TGenericClass<T>.TGenericInternalClass<T, I>.Destroy;
begin
//
inherited;
end;
procedure TGenericClass<T>.TGenericInternalClass<T, I>.CopyTo<I>(Dest: TGenericInternalClass<T, I>);
begin
Dest.Name := Name;
Dest.Id := Id;
Dest.Value := Value;
end;
// -----------------------------------------------------------------------------
// TEnumHelper
// -----------------------------------------------------------------------------
function TEnumHelper.ToString: string;
begin
case Self of
enMember2: Result := 'Member 2';
enMember3: Result := 'Member 3';
else Result := 'Unknown';
end;
end;
class function TEnumHelper.FromString(const AString: string): TEnum;
begin
if SameText(AString, 'Member 2') then
Result := enMember2
if SameText(AString, 'Member 3') then
Result := enMember3
else
Result := enMember1;
end;
// -----------------------------------------------------------------------------
// TStdClassHelper
// -----------------------------------------------------------------------------
function TStdClassHelper.AsString: string;
begin
Result := 'TStdClass instance';
end;
class function TStdClassHelper.FromString(const AString: string): TStdClass;
begin
Result := TStdClass.Create.Convert<TStdClass>(AString);
end;
end.

@ -0,0 +1 @@
{"leaves":["FreeFunc","FreeFunc","FreeFunc2","FreeFunc2Internal","FreeFunc3","FreeFunc3Internal","FreeFunc4","FreeFunc4Internal","FreeFunc5","FreeFunc5Internal","InitStdInternalClass","ReInitStdInternalClass"],"nodes":[{"leaves":["Create","Destroy","Init","DeInit","SetValue","Convert<X>"],"name":"TStdClass"},{"leaves":["Create","Destroy","CopyTo"],"name":"TStdClass.TStdInternalClass"},{"leaves":["Create","Destroy","Init<I>","DeInit","SetValue"],"name":"TGenericClass<T>"},{"leaves":["Create","Destroy","CopyTo<I>"],"name":"TGenericClass<T>.TGenericInternalClass<T, I>"},{"leaves":["ToString","FromString"],"name":"TEnumHelper"},{"leaves":["AsString","FromString"],"name":"TStdClassHelper"}],"root":"unitTest"}

@ -0,0 +1,161 @@
<?xml version="1.0" encoding="UTF-8" ?>
<!-- ==========================================================================\
|
| To learn how to make your own language parser, please check the following
| link:
| https://npp-user-manual.org/docs/function-list/
|
\=========================================================================== -->
<NotepadPlus>
<functionList>
<!-- ====================================================== [ Pascal ] -->
<parser
displayName="Pascal"
id ="pascal_syntax"
commentExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?s:\x7B.*?\x7D) # Multi Line Comment 1st variant
| (?s:\x28\x2A.*?\x2A\x29) # Multi Line Comment 2nd variant
| (?m-s:\x2F{2}.*$) # Single Line Comment
"
>
<classRange
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off
^\h* # optional leading whitespace
(?:
CLASS\s+
)?
(?:
(?'CONSTRUCTOR_HEADER' # constructor
CONSTRUCTOR
)
| # or
(?'DESTRUCTOR_HEADER' # destructor
DESTRUCTOR
)
| # or
(?'PROCEDURE_HEADER' # procedure
PROCEDURE
)
| # or
(?'FUNCTION_HEADER' # function
FUNCTION
)
| # or
(?'OPERATOR_HEADER' # operator
OPERATOR
)
)\s+
(?'CLASS_NAME' # class/interface name
(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+ # match nested classes too
)
(?'METHOD_NAME' # method name
[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?
)
(?'PARAM_LIST' # optional parameter list
\s*\( # start-of-parameter-list indicator
[^()]* # parameter list
\) # end-of-parameter-list indicator
)?
(?('CONSTRUCTOR_HEADER') # constructors don't have a return type
\s*
; # end-of-statement indicator
)
(?('DESTRUCTOR_HEADER') # destructors don't have a return type
\s*
; # end-of-statement indicator
)
(?('PROCEDURE_HEADER') # procedures don't have a return type
\s*
; # end-of-statement indicator
)
(?('FUNCTION_HEADER') # functions have a return type
\s*: # type indicator
\s*[^;]+ # type identifier
; # end-of-statement indicator
)
(?('OPERATOR_HEADER') # operators have a return type
\s*: # type indicator
\s*[^;]+ # type identifier
; # end-of-statement indicator
)
"
>
<className>
<nameExpr expr="(?i)(?:(CONSTRUCTOR|DESTRUCTOR|PROCEDURE|FUNCTION|OPERATOR)\s+)\K(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)(?:[A-Z_]\w*)" />
<nameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)(?=[A-Z_])" />
<nameExpr expr="(?i)(?:(?:\s*\.\s*)?[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)+(?!\Z)" />
</className>
<function
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off
\s+
(?'CLASS_NAME' # class/interface name
(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+
)
(?'METHOD_NAME' # method name
[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?
)
(?'PARAM_LIST' # optional parameter list
\s*\( # start-of-parameter-list indicator
[^()]* # parameter list
\) # end-of-parameter-list indicator
)?
"
>
<functionName>
<funcNameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)\K(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?:\s*\([^()]*\))*" />
<!-- comment out the following node to display the method with its parameters -->
<funcNameExpr expr="(?i)(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?=\s*|\(|\Z)" />
</functionName>
</function>
</classRange>
<function
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off
^\h* # optional leading whitespace
(?:
(?:PROCEDURE\s+ # procedure
([A-Z_]\w*)\s* # name
(?: # optional parameter list
\([^()]*\)
)?\s*
; # end-of-statement indicator
)
| (?:FUNCTION\s+ # or function
([A-Z_]\w*)\s* # name
(?: # optional parameter list
\([^()]*\)
)?\s*
:\s*[^;]+ # return type
; # end-of-statement indicator
)
)
(?:\s*OVERLOAD\s*;)? # function/procedure overloading
(?:\s*(?:REGISTER|PASCAL|CDECL|STDCALL|SAFECALL)\s*;)? # calling convention
(?: # external function from object file
(?:\s*(?:VARARGS)\s*;) # variadic C function with cdecl calling convention
| (?:\s*(?:EXTERNAL)\s+[^;]+;) # or normal function
)?
(?!\s*(?:FORWARD)\s*;) # prevent matching forward declarations
(?=(?:\s* # only match function/procedure definitions
(?: # optional comment
(?s:\x7B.*?\x7D) # multi line comment 1st variant
| (?s:\x28\x2A.*?\x2A\x29) # or multi line comment 2nd variant
| (?-s:\x2F{2}.*$) # or single line comment
)
)*
\s*(?:CONST|TYPE|VAR|LABEL|BEGIN|(?R))\s* # declaration block
)
"
>
<functionName>
<nameExpr expr="(?i)(?:(PROCEDURE|FUNCTION)\s+)\K(?:[A-Z_]\w*)(?:\s*\([^()]*\))*" />
<!-- comment out the following node to display the routine with its parameters -->
<nameExpr expr="(?i)(?:[A-Z_]\w*)(?=\s*|\(|$)" />
</functionName>
</function>
</parser>
</functionList>
</NotepadPlus>
Loading…
Cancel
Save