tyler.durden/notepad-plus-plus
1
0
Fork 0
mirror of https://github.com/notepad-plus-plus/notepad-plus-plus.git synced 2025-07-15 18:04:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

Make Pascal/Delphi functionList more efficient and more reliable

Browse Source 
Fix #12808, close #12811
This commit is contained in:
Andreas Heim 2023-01-17 15:34:39 +01:00 committed by Don Ho
parent b280db88dc
commit d476a894c2
3 changed files with 206 additions and 174 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

229
PowerEditor/Test/FunctionList/pascal/unitTest
View File

@ -1,4 +1,4 @@
unit Test; unit unitTest;
interface interface
@ -7,7 +7,7 @@ uses
System.SysUtils, System.Types, System.Classes; System.SysUtils, System.Types, System.Classes;
function FreeFunc(const Param: integer): integer; function FreeFunc1(const Param: integer): integer;
type type
@ -40,6 +40,7 @@ type
class function Init(Cnt: integer): boolean; class function Init(Cnt: integer): boolean;
class function DeInit(Cnt: integer): boolean; class function DeInit(Cnt: integer): boolean;
class function ToType<X: class, constructor>(const Value: string): X;
procedure SetValue(const Value: string); procedure SetValue(const Value: string);
@ -63,21 +64,21 @@ type
TGenericClass<T> = class(TObject) TGenericClass<T> = class(TObject)
private type private type
TGenericInternalClass<T, I> = class(TObject) TGenericInternalClass<I, K> = class(TObject)
strict private strict private
FName: string; FName: string;
FId: T; FId: I;
FValue: I; FValue: K;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure CopyTo<I>(Dest: TGenericInternalClass<T, I>); procedure CopyTo<J>(Dest: TGenericInternalClass<I, K>);
property Name: string read FName write FName; property Name: string read FName write FName;
property Id: T read FId write FId; property Id: I read FId write FId;
property Value: I read FValue write FValue; property Value: K read FValue write FValue;
end; end;
strict private strict private
@ -132,18 +133,18 @@ type
// Free routines // Free routines
// ----------------------------------------------------------------------------- // -----------------------------------------------------------------------------
function FreeFunc2(const Param: integer): integer; procedure FreeProc1(AParam: integer);
procedure Foo(AParam: integer); function FreeFunc2(const AParam: string): integer;
function Bar(const AParam: string): integer; procedure FreeProc2(AParam: integer);
{function Unused1(ANum: double): cardinal;} {function UnusedFreeFunc1(ANum: double): cardinal;}
procedure Boo(AParam: integer); procedure FreeProc3(AParam: integer);
(* (*
function Unused2(ANum: double): cardinal; function UnusedFreeFunc2(ANum: double): cardinal;
function Unused3(ANum: double): cardinal; function UnusedFreeFunc3(ANum: double): cardinal;
*) *)
@ -157,64 +158,97 @@ implementation
// Free routines // Free routines
// ----------------------------------------------------------------------------- // -----------------------------------------------------------------------------
{ Free function 3 }
function FreeFunc3(const Param: integer): integer; forward; function FreeFunc3(const Param: integer): integer; forward;
{ Free function 1 } { Free function 1 }
function FreeFunc(const Param: integer): integer; function FreeFunc1(const Param: integer): integer;
begin
//
Result := 0;
end;
{ Free procedure 1 }
procedure FreeProc1(AParam: integer);
begin
// Do something
end;
{ Free function 2 }
function FreeFunc2(const AParam: string): integer;
begin
// Do something
Result := 0;
end;
{
// Unused free function 1
function UnusedFreeFunc1(ANum: double): cardinal;
begin
// Do something
Result := 0;
end;
}
{ Free procedure 2 }
procedure FreeProc2(AParam: integer);
begin
// Do something
end;
(*
// Unused free function 2
function UnusedFreeFunc2(ANum: double): cardinal;
begin
// Do something
Result := 0;
end;
{ Unused free function 3 }
function UnusedFreeFunc3(ANum: double): cardinal;
begin
// Do something
Result := 0;
end;
*)
{ Free procedure 3 }
procedure FreeProc3(AParam: integer);
begin begin
// //
end; end;
{ Free function Foo } procedure FreeProc4(const Param: integer); forward;
procedure Foo(AParam: integer);
begin
// Do something
end;
{ Free function Bar }
function Bar(const AParam: string): integer;
begin
// Do something
Result := 0;
end;
{ Free function Test }
function Test(Tnum: Double): DWord;
begin
// Do something
Result := 0;
end;
{ Free function Boo }
procedure Boo(AParam: integer);
begin
// Do something
Result := 0;
end;
{ Free function 4 }
procedure FreeFunc4(const Param: integer); forward;
@ -241,12 +275,20 @@ end;
class function TStdClass.Init(Cnt: integer): boolean; class function TStdClass.Init(Cnt: integer): boolean;
begin begin
FInstCnt := Cnt; FInstCnt := Cnt;
Result := true;
end; end;
class function TStdClass.DeInit(Cnt: integer): boolean; class function TStdClass.DeInit(Cnt: integer): boolean;
begin begin
FInstCnt := Cnt; FInstCnt := Cnt;
Result := true;
end;
class function TStdClass.ToType<X>(const Value: string): X;
begin
Result := X.Create;
end; end;
@ -296,44 +338,32 @@ end;
// Free routines // 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 } { Free function 3 with internal procedure }
function FreeFunc3: integer; function FreeFunc3(const Param: integer): integer;
procedure FreeFunc3Internal(const Param: integer); procedure InternalProc1(const Param: integer);
begin begin
// //
end; end;
begin begin
// //
Result := 0;
end; end;
{ Free procedure 4 with internal function } { Free procedure 4 with internal function }
procedure FreeFunc4; procedure FreeProc4(const Param: integer);
function FreeFunc4Internal(const Param: integer): string; function InternalFunc1(const Param: integer): string;
begin begin
// //
Result := '';
end; end;
begin begin
@ -344,10 +374,10 @@ end;
{ Free procedure 5 with internal procedure preceeded by a comment } { Free procedure 5 with internal procedure preceeded by a comment }
procedure FreeFunc5; procedure FreeProc5;
// Internal routine // Internal routine
procedure FreeFunc5Internal; procedure InternalProc2;
begin begin
// //
end; end;
@ -380,23 +410,9 @@ end;
// This is a class function // This is a class function
class function TGenericClass<T>.Init<I>(Cnt: integer): boolean; 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 begin
FInstCnt := Cnt; FInstCnt := Cnt;
Result := true;
end; end;
@ -404,6 +420,7 @@ end;
class function TGenericClass<T>.DeInit(Cnt: integer): boolean; class function TGenericClass<T>.DeInit(Cnt: integer): boolean;
begin begin
FInstCnt := Cnt; FInstCnt := Cnt;
Result := true;
end; end;
@ -415,20 +432,20 @@ end;
// ----------------------------------------------------------------------------- // -----------------------------------------------------------------------------
// TGenericClass<T>.TGenericInternalClass<T, I> // TGenericClass<T>.TGenericInternalClass<I, K>
// ----------------------------------------------------------------------------- // -----------------------------------------------------------------------------
constructor TGenericClass<T>.TGenericInternalClass<T, I>.Create; constructor TGenericClass<T>.TGenericInternalClass<I, K>.Create;
begin begin
inherited; inherited;
FValue := ''; FName := '';
FId := Default(T); FId := Default(I);
FName := Default(I); FValue := Default(K);
end; end;
destructor TGenericClass<T>.TGenericInternalClass<T, I>.Destroy; destructor TGenericClass<T>.TGenericInternalClass<I, K>.Destroy;
begin begin
// //
@ -436,7 +453,7 @@ begin
end; end;
procedure TGenericClass<T>.TGenericInternalClass<T, I>.CopyTo<I>(Dest: TGenericInternalClass<T, I>); procedure TGenericClass<T>.TGenericInternalClass<I, K>.CopyTo<J>(Dest: TGenericInternalClass<I, K>);
begin begin
Dest.Name := Name; Dest.Name := Name;
Dest.Id := Id; Dest.Id := Id;
@ -464,7 +481,7 @@ begin
if SameText(AString, 'Member 2') then if SameText(AString, 'Member 2') then
Result := enMember2 Result := enMember2
if SameText(AString, 'Member 3') then else if SameText(AString, 'Member 3') then
Result := enMember3 Result := enMember3
else else

2
PowerEditor/Test/FunctionList/pascal/unitTest.expected.result
View File

@ -1 +1 @@
{"leaves":["FreeFunc","Foo","Bar","Test","Boo","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"} {"leaves":["FreeFunc1","FreeProc1","FreeFunc2","FreeProc2","FreeProc3","FreeFunc3","InternalProc1","FreeProc4","InternalFunc1","FreeProc5","InternalProc2"],"nodes":[{"leaves":["Create","Destroy","Init","DeInit","ToType<X>","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<J>"],"name":"TGenericClass<T>.TGenericInternalClass<I, K>"},{"leaves":["ToString","FromString"],"name":"TEnumHelper"},{"leaves":["AsString","FromString"],"name":"TStdClassHelper"}],"root":"unitTest"}

149
PowerEditor/installer/functionList/pascal.xml
View File

@ -8,81 +8,85 @@
\=========================================================================== --> \=========================================================================== -->
<NotepadPlus> <NotepadPlus>
<functionList> <functionList>
<!-- ====================================================== [ Pascal ] --> <!-- ==================================================== [ Pascal ] -->
<!-- ====================================================== [ Pascal ] -->
<parser <parser
displayName="Pascal" displayName="Pascal"
id ="pascal_syntax" id ="pascal_syntax"
commentExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`) commentExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?s:\x7B.*?\x7D) # Multi Line Comment 1st variant (?m-s:\x2F{2}.*$) # Single Line Comment
| (?s:\x7B.*?\x7D) # Multi Line Comment 1st variant
| (?s:\x28\x2A.*?\x2A\x29) # Multi Line Comment 2nd variant | (?s:\x28\x2A.*?\x2A\x29) # Multi Line Comment 2nd variant
| (?m-s:\x2F{2}.*$) # Single Line Comment | (?is:^\h*INTERFACE\h*$.*?^\h*IMPLEMENTATION\h*$) # Prevent matching procedure/function declarations in interface section of unit
" "
> >
<classRange <classRange
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`) mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off (?im-s) # multi-line mode on, single-line mode off
^\h* # optional leading whitespace ^\h* # optional leading whitespace
(?: (?: # indicator that following element exists on class level instead of instance level
CLASS\s+ CLASS\s+
)? )?
(?: (?:
(?'CONSTRUCTOR_HEADER' # constructor (?'CONSTRUCTOR_HEADER' # constructor
CONSTRUCTOR CONSTRUCTOR
) )
| # or | (?'DESTRUCTOR_HEADER' # or destructor
(?'DESTRUCTOR_HEADER' # destructor DESTRUCTOR
DESTRUCTOR )
) | (?'PROCEDURE_HEADER' # or procedure
| # or PROCEDURE
(?'PROCEDURE_HEADER' # procedure )
PROCEDURE | (?'FUNCTION_HEADER' # or function
) FUNCTION
| # or )
(?'FUNCTION_HEADER' # function | (?'OPERATOR_HEADER' # or operator
FUNCTION OPERATOR
) )
| # or
(?'OPERATOR_HEADER' # operator
OPERATOR
)
)\s+ )\s+
(?'CLASS_NAME' # class/interface name (?'CLASS_NAME' # class/interface name
(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+ # match nested classes too (?:
[A-Z_]\w*
(?: # match generic classes too
\s*&lt;[^&gt;]+&gt;
)?
\s*\.\s*
)+ # match nested classes too
) )
(?'METHOD_NAME' # method name (?'METHOD_NAME' # method name
[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)? [A-Z_]\w*
(?: # match generic methods too
\s*&lt;[^&gt;]+&gt;
)?
) )
(?'PARAM_LIST' # optional parameter list (?'PARAM_LIST' # optional parameter list
\s*\( # start-of-parameter-list indicator \s*\( # start-of-parameter-list indicator
[^()]* # parameter list [^()]* # parameter list
\) # end-of-parameter-list indicator \) # end-of-parameter-list indicator
)? )?
(?('CONSTRUCTOR_HEADER') # constructors don't have a return type (?('CONSTRUCTOR_HEADER') # constructors don't have a return type
\s* \s*
; # end-of-statement indicator ; # end-of-statement indicator
) )
(?('DESTRUCTOR_HEADER') # destructors don't have a return type (?('DESTRUCTOR_HEADER') # destructors don't have a return type
\s* \s*
; # end-of-statement indicator ; # end-of-statement indicator
) )
(?('PROCEDURE_HEADER') # procedures don't have a return type (?('PROCEDURE_HEADER') # procedures don't have a return type
\s* \s*
; # end-of-statement indicator ; # end-of-statement indicator
) )
(?('FUNCTION_HEADER') # functions have a return type (?('FUNCTION_HEADER') # functions have a return type
\s*: # type indicator \s*: # return type indicator
\s*[^;]+ # type identifier \s*[^;]+ # return type identifier
; # end-of-statement indicator ; # end-of-statement indicator
) )
(?('OPERATOR_HEADER') # operators have a return type (?('OPERATOR_HEADER') # operators have a return type
\s*: # type indicator \s*: # type indicator
\s*[^;]+ # type identifier \s*[^;]+ # type identifier
; # end-of-statement indicator ; # end-of-statement indicator
) )
" "
> >
<className> <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)(?:(CONSTRUCTOR|DESTRUCTOR|PROCEDURE|FUNCTION|OPERATOR)\s+)\K(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)(?:[A-Z_]\w*)" />
@ -93,18 +97,27 @@
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`) mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off (?im-s) # multi-line mode on, single-line mode off
\s+ \s+
(?'CLASS_NAME' # class/interface name ( # class/interface name
(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+ (?:
[A-Z_]\w*
(?: # match generic classes too
\s*&lt;[^&gt;]+&gt;
)?
\s*\.\s*
)+ # match nested classes too
) )
(?'METHOD_NAME' # method name ( # method name
[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)? [A-Z_]\w*
(?: # match generic methods too
\s*&lt;[^&gt;]+&gt;
)?
) )
(?'PARAM_LIST' # optional parameter list ( # optional parameter list
\s*\( # start-of-parameter-list indicator \s*\( # start-of-parameter-list indicator
[^()]* # parameter list [^()]* # parameter list
\) # end-of-parameter-list indicator \) # end-of-parameter-list indicator
)? )?
" "
> >
<functionName> <functionName>
<funcNameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)\K(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?:\s*\([^()]*\))*" /> <funcNameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)\K(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?:\s*\([^()]*\))*" />
@ -117,32 +130,34 @@
mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`) mainExpr="(?x) # Utilize inline comments (see `RegEx - Pattern Modifiers`)
(?im-s) # multi-line mode on, single-line mode off (?im-s) # multi-line mode on, single-line mode off
^\h* # optional leading whitespace ^\h* # optional leading whitespace
(?: (?:
(?:PROCEDURE\s+ # procedure (?:
([A-Z_]\w*)\s* # name PROCEDURE\s+ # procedure
(?: # optional parameter list ([A-Z_]\w*)\s* # name
\([^()]*\) (?: # optional parameter list
)?\s* \([^()]*\)
; # end-of-statement indicator )?
) \s*; # end-of-statement indicator
| (?:FUNCTION\s+ # or function )
([A-Z_]\w*)\s* # name | (?:
(?: # optional parameter list FUNCTION\s+ # or function
\([^()]*\) ([A-Z_]\w*)\s* # name
)?\s* (?: # optional parameter list
:\s*[^;]+ # return type \([^()]*\)
; # end-of-statement indicator )?
) \s*: # return type indicator
) \s*[^;]+ # return type identifier
; # end-of-statement indicator
)
)
(?:\s*OVERLOAD\s*;)? # function/procedure overloading (?:\s*OVERLOAD\s*;)? # function/procedure overloading
(?:\s*(?:REGISTER|PASCAL|CDECL|STDCALL|SAFECALL)\s*;)? # calling convention (?:\s*(?:REGISTER|PASCAL|CDECL|STDCALL|SAFECALL)\s*;)? # calling convention
(?: # external function from object file (?: # external function from object file
(?:\s*(?:VARARGS)\s*;) # variadic C function with cdecl calling convention (?:\s*(?:VARARGS)\s*;) # variadic C function with cdecl calling convention
| (?:\s*(?:EXTERNAL)\s+[^;]+;) # or normal function | (?:\s*(?:EXTERNAL)\s+[^;]+;) # or normal function
)? )?
(?! (?!
(?s:.*?^\h*IMPLEMENTATION\s+) # prevent matching declarations in interface section of unit (?:\s*FORWARD\s*;) # prevent matching forward declarations in implementation section of unit
| (?:\s*FORWARD\s*;) # prevent matching forward declarations in implementation section of unit
) )
" "
> >