paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 12:00:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: starting a parser for pascal expressions / rename and test

Browse Source 
git-svn-id: trunk@43210 -
This commit is contained in:
martin 2013-10-11 18:35:33 +00:00
parent fc9c962339
commit 6dd2f1eb24
5 changed files with 508 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -1239,10 +1239,13 @@ components/fpdebug/fpimgreaderelftypes.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderwinpe.pas svneol=native#text/pascal components/fpdebug/fpimgreaderwinpe.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderwinpetypes.pas svneol=native#text/pascal components/fpdebug/fpimgreaderwinpetypes.pas svneol=native#text/pascal
components/fpdebug/fppascalparser.pas svneol=native#text/pascal components/fpdebug/fppascalparser.pas svneol=native#text/pascal
components/fpdebug/test/FpTest.lpi svneol=native#text/pascal
components/fpdebug/test/FpTest.lpr svneol=native#text/pascal
components/fpdebug/test/asmtest.lpi svneol=native#text/plain components/fpdebug/test/asmtest.lpi svneol=native#text/plain
components/fpdebug/test/asmtest.lpr svneol=native#text/pascal components/fpdebug/test/asmtest.lpr svneol=native#text/pascal
components/fpdebug/test/asmtestunit.lfm svneol=native#text/plain components/fpdebug/test/asmtestunit.lfm svneol=native#text/plain
components/fpdebug/test/asmtestunit.pas svneol=native#text/pascal components/fpdebug/test/asmtestunit.pas svneol=native#text/pascal
components/fpdebug/test/testpascalparser.pas svneol=native#text/pascal
components/fppkg/images/archive.png -text components/fppkg/images/archive.png -text
components/fppkg/images/broken.png -text components/fppkg/images/broken.png -text
components/fppkg/images/build.png -text components/fppkg/images/build.png -text

370
components/fpdebug/fppascalparser.pas
View File

@ -29,31 +29,31 @@ unit FpPascalParser;
interface interface
uses uses
Classes, sysutils, math, LCLProc, FpDbgDwarf, LazLoggerBase; Classes, sysutils, math, FpDbgDwarf, LazLoggerBase;
type type
TFpGDBMIExpressionPart = class; TFpPascalExpressionPart = class;
TFpGDBMIExpressionPartContainer = class; TFpPascalExpressionPartContainer = class;
TFpGDBMIExpressionPartBracket = class; TFpPascalExpressionPartBracket = class;
TFpGDBMIExpressionPartOperator = class; TFpPascalExpressionPartOperator = class;
TFpGDBMIExpressionPartClass = class of TFpGDBMIExpressionPart; TFpPascalExpressionPartClass = class of TFpPascalExpressionPart;
TFpGDBMIExpressionPartBracketClass = class of TFpGDBMIExpressionPartBracket; TFpPascalExpressionPartBracketClass = class of TFpPascalExpressionPartBracket;
{ TFpGDBMIExpression } { TFpPascalExpression }
TFpGDBMIExpression = class TFpPascalExpression = class
private private
FError: String; FError: String;
FTextExpression: String; FTextExpression: String;
FExpressionPart: TFpGDBMIExpressionPart; FExpressionPart: TFpPascalExpressionPart;
FValid: Boolean; FValid: Boolean;
procedure Parse; procedure Parse;
procedure SetError(AMsg: String); procedure SetError(AMsg: String);
function PosFromPChar(APChar: PChar): Integer; function PosFromPChar(APChar: PChar): Integer;
protected protected
property ExpressionPart: TFpGDBMIExpressionPart read FExpressionPart; property ExpressionPart: TFpPascalExpressionPart read FExpressionPart;
public public
constructor Create(ATextExpression: String); constructor Create(ATextExpression: String);
destructor Destroy; override; destructor Destroy; override;
@ -63,81 +63,81 @@ type
end; end;
{ TFpGDBMIExpressionPart } { TFpPascalExpressionPart }
TFpGDBMIExpressionPart = class TFpPascalExpressionPart = class
private private
FEndChar: PChar; FEndChar: PChar;
FParent: TFpGDBMIExpressionPartContainer; FParent: TFpPascalExpressionPartContainer;
FStartChar: PChar; FStartChar: PChar;
FExpression: TFpGDBMIExpression; FExpression: TFpPascalExpression;
function GetSurroundingBracket: TFpGDBMIExpressionPartBracket; function GetSurroundingBracket: TFpPascalExpressionPartBracket;
function GetTopParent: TFpGDBMIExpressionPart; function GetTopParent: TFpPascalExpressionPart;
procedure SetEndChar(AValue: PChar); procedure SetEndChar(AValue: PChar);
procedure SetParent(AValue: TFpGDBMIExpressionPartContainer); procedure SetParent(AValue: TFpPascalExpressionPartContainer);
procedure SetStartChar(AValue: PChar); procedure SetStartChar(AValue: PChar);
function GetText(AMaxLen: Integer=0): String;
procedure SetError(AMsg: String = ''); procedure SetError(AMsg: String = '');
procedure SetError(APart: TFpGDBMIExpressionPart; AMsg: String = ''); procedure SetError(APart: TFpPascalExpressionPart; AMsg: String = '');
protected protected
function DebugText(AIndent: String): String; virtual; // Self desc only function DebugText(AIndent: String): String; virtual; // Self desc only
function DebugDump(AIndent: String): String; virtual; function DebugDump(AIndent: String): String; virtual;
protected protected
procedure Init; virtual; procedure Init; virtual;
Procedure ReplaceInParent(AReplacement: TFpGDBMIExpressionPart); Procedure ReplaceInParent(AReplacement: TFpPascalExpressionPart);
procedure DoHandleEndOfExpression; virtual; procedure DoHandleEndOfExpression; virtual;
function IsValidNextPart(APart: TFpGDBMIExpressionPart): Boolean; virtual; function IsValidNextPart(APart: TFpPascalExpressionPart): Boolean; virtual;
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; virtual; function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; virtual;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; virtual; var AResult: TFpPascalExpressionPart): Boolean; virtual;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; virtual; function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart; virtual;
function CanHaveOperatorAsNext: Boolean; virtual; // True function CanHaveOperatorAsNext: Boolean; virtual; // True
public public
constructor Create(AExpression: TFpGDBMIExpression; AStartChar: PChar; AnEndChar: PChar = nil); constructor Create(AExpression: TFpPascalExpression; AStartChar: PChar; AnEndChar: PChar = nil);
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; virtual; function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; virtual;
procedure HandleEndOfExpression; virtual; procedure HandleEndOfExpression; virtual;
function GetText(AMaxLen: Integer=0): String;
property StartChar: PChar read FStartChar write SetStartChar; property StartChar: PChar read FStartChar write SetStartChar;
property EndChar: PChar read FEndChar write SetEndChar; property EndChar: PChar read FEndChar write SetEndChar;
property Parent: TFpGDBMIExpressionPartContainer read FParent write SetParent; property Parent: TFpPascalExpressionPartContainer read FParent write SetParent;
property TopParent: TFpGDBMIExpressionPart read GetTopParent; // or self property TopParent: TFpPascalExpressionPart read GetTopParent; // or self
property SurroundingBracket: TFpGDBMIExpressionPartBracket read GetSurroundingBracket; // incl self property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingBracket; // incl self
end; end;
{ TFpGDBMIExpressionPartContainer } { TFpPascalExpressionPartContainer }
TFpGDBMIExpressionPartContainer = class(TFpGDBMIExpressionPart) TFpPascalExpressionPartContainer = class(TFpPascalExpressionPart)
private private
FList: TList; FList: TList;
function GetCount: Integer; function GetCount: Integer;
function GetItems(AIndex: Integer): TFpGDBMIExpressionPart; function GetItems(AIndex: Integer): TFpPascalExpressionPart;
function GetLastItem: TFpGDBMIExpressionPart; function GetLastItem: TFpPascalExpressionPart;
procedure SetItems(AIndex: Integer; AValue: TFpGDBMIExpressionPart); procedure SetItems(AIndex: Integer; AValue: TFpPascalExpressionPart);
procedure SetLastItem(AValue: TFpGDBMIExpressionPart); procedure SetLastItem(AValue: TFpPascalExpressionPart);
protected protected
procedure Init; override; procedure Init; override;
function DebugDump(AIndent: String): String; override; function DebugDump(AIndent: String): String; override;
public public
destructor Destroy; override; destructor Destroy; override;
function Add(APart: TFpGDBMIExpressionPart): Integer; function Add(APart: TFpPascalExpressionPart): Integer;
function IndexOf(APart: TFpGDBMIExpressionPart): Integer; function IndexOf(APart: TFpPascalExpressionPart): Integer;
procedure Clear; procedure Clear;
property Count: Integer read GetCount; property Count: Integer read GetCount;
property Items[AIndex: Integer]: TFpGDBMIExpressionPart read GetItems write SetItems; property Items[AIndex: Integer]: TFpPascalExpressionPart read GetItems write SetItems;
property LastItem: TFpGDBMIExpressionPart read GetLastItem write SetLastItem; property LastItem: TFpPascalExpressionPart read GetLastItem write SetLastItem;
end; end;
{ TFpGDBMIExpressionPartIdentifer } { TFpPascalExpressionPartIdentifer }
TFpGDBMIExpressionPartIdentifer = class(TFpGDBMIExpressionPartContainer) TFpPascalExpressionPartIdentifer = class(TFpPascalExpressionPartContainer)
public public
end; end;
{ TFpGDBMIExpressionPartBracket } { TFpPascalExpressionPartBracket }
TFpGDBMIExpressionPartBracket = class(TFpGDBMIExpressionPartContainer) TFpPascalExpressionPartBracket = class(TFpPascalExpressionPartContainer)
private private
FIsClosed: boolean; FIsClosed: boolean;
FIsClosing: boolean; FIsClosing: boolean;
@ -147,147 +147,147 @@ type
function CanHaveOperatorAsNext: Boolean; override; function CanHaveOperatorAsNext: Boolean; override;
public public
procedure CloseBracket; procedure CloseBracket;
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override; function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
procedure HandleEndOfExpression; override; procedure HandleEndOfExpression; override;
property IsClosed: boolean read FIsClosed; property IsClosed: boolean read FIsClosed;
end; end;
{ TFpGDBMIExpressionPartRoundBracket } { TFpPascalExpressionPartRoundBracket }
TFpGDBMIExpressionPartRoundBracket = class(TFpGDBMIExpressionPartBracket) TFpPascalExpressionPartRoundBracket = class(TFpPascalExpressionPartBracket)
end; end;
{ TFpGDBMIExpressionPartOperator } { TFpPascalExpressionPartOperator }
TFpGDBMIExpressionPartOperator = class(TFpGDBMIExpressionPartContainer) TFpPascalExpressionPartOperator = class(TFpPascalExpressionPartContainer)
private private
FPrecedence: Integer; FPrecedence: Integer;
protected protected
function DebugText(AIndent: String): String; override; function DebugText(AIndent: String): String; override;
function CanHaveOperatorAsNext: Boolean; override; function CanHaveOperatorAsNext: Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; override; function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart; override;
function HasAllOperands: Boolean; virtual; abstract; function HasAllOperands: Boolean; virtual; abstract;
function MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart; function MaybeAddLeftOperand(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; var AResult: TFpPascalExpressionPart): Boolean;
procedure DoHandleEndOfExpression; override; procedure DoHandleEndOfExpression; override;
public public
function HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; override; function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
property Precedence: Integer read FPrecedence; property Precedence: Integer read FPrecedence;
end; end;
{ TFpGDBMIExpressionPartUnaryOperator } { TFpPascalExpressionPartUnaryOperator }
TFpGDBMIExpressionPartUnaryOperator = class(TFpGDBMIExpressionPartOperator) TFpPascalExpressionPartUnaryOperator = class(TFpPascalExpressionPartOperator)
protected protected
function HasAllOperands: Boolean; override; function HasAllOperands: Boolean; override;
public public
end; end;
{ TFpGDBMIExpressionPartBinaryOperator } { TFpPascalExpressionPartBinaryOperator }
TFpGDBMIExpressionPartBinaryOperator = class(TFpGDBMIExpressionPartOperator) TFpPascalExpressionPartBinaryOperator = class(TFpPascalExpressionPartOperator)
protected protected
function HasAllOperands: Boolean; override; function HasAllOperands: Boolean; override;
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; override; function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;
public public
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override; var AResult: TFpPascalExpressionPart): Boolean; override;
end; end;
{ TFpGDBMIExpressionPartOperatorAddressOf } { TFpPascalExpressionPartOperatorAddressOf }
TFpGDBMIExpressionPartOperatorAddressOf = class(TFpGDBMIExpressionPartUnaryOperator) // @ TFpPascalExpressionPartOperatorAddressOf = class(TFpPascalExpressionPartUnaryOperator) // @
protected protected
procedure Init; override; procedure Init; override;
end; end;
{ TFpGDBMIExpressionPartOperatorMakeRef } { TFpPascalExpressionPartOperatorMakeRef }
TFpGDBMIExpressionPartOperatorMakeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ^TTYpe TFpPascalExpressionPartOperatorMakeRef = class(TFpPascalExpressionPartUnaryOperator) // ^TTYpe
protected protected
procedure Init; override; procedure Init; override;
end; end;
{ TFpGDBMIExpressionPartOperatorDeRef } { TFpPascalExpressionPartOperatorDeRef }
TFpGDBMIExpressionPartOperatorDeRef = class(TFpGDBMIExpressionPartUnaryOperator) // ptrval^ TFpPascalExpressionPartOperatorDeRef = class(TFpPascalExpressionPartUnaryOperator) // ptrval^
protected protected
procedure Init; override; procedure Init; override;
function MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; override; var AResult: TFpPascalExpressionPart): Boolean; override;
function FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; function FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart;
override; override;
// IsValidAfterPart: same as binary op // IsValidAfterPart: same as binary op
function IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; override; function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;
end; end;
{ TFpGDBMIExpressionPartOperatorUnaryPlusMinus } { TFpPascalExpressionPartOperatorUnaryPlusMinus }
TFpGDBMIExpressionPartOperatorUnaryPlusMinus = class(TFpGDBMIExpressionPartUnaryOperator) // + - TFpPascalExpressionPartOperatorUnaryPlusMinus = class(TFpPascalExpressionPartUnaryOperator) // + -
// Unary + - // Unary + -
protected protected
procedure Init; override; procedure Init; override;
end; end;
{ TFpGDBMIExpressionPartOperatorPlusMinus } { TFpPascalExpressionPartOperatorPlusMinus }
TFpGDBMIExpressionPartOperatorPlusMinus = class(TFpGDBMIExpressionPartBinaryOperator) // + - TFpPascalExpressionPartOperatorPlusMinus = class(TFpPascalExpressionPartBinaryOperator) // + -
// Binary + - // Binary + -
protected protected
procedure Init; override; procedure Init; override;
end; end;
{ TFpGDBMIExpressionPartOperatorMulDiv } { TFpPascalExpressionPartOperatorMulDiv }
TFpGDBMIExpressionPartOperatorMulDiv = class(TFpGDBMIExpressionPartBinaryOperator) // * / TFpPascalExpressionPartOperatorMulDiv = class(TFpPascalExpressionPartBinaryOperator) // * /
protected protected
procedure Init; override; procedure Init; override;
end; end;
{ TFpGDBMIExpressionPartOperatorMemberOf } { TFpPascalExpressionPartOperatorMemberOf }
TFpGDBMIExpressionPartOperatorMemberOf = class(TFpGDBMIExpressionPartBinaryOperator) // struct.member TFpPascalExpressionPartOperatorMemberOf = class(TFpPascalExpressionPartBinaryOperator) // struct.member
protected protected
procedure Init; override; procedure Init; override;
end; end;
implementation implementation
{ TFpGDBMIExpressionPartOperatorMemberOf } { TFpPascalExpressionPartOperatorMemberOf }
procedure TFpGDBMIExpressionPartOperatorMemberOf.Init; procedure TFpPascalExpressionPartOperatorMemberOf.Init;
begin begin
FPrecedence := 0; FPrecedence := 0;
inherited Init; inherited Init;
end; end;
{ TFpGDBMIExpressionPartOperatorMakeRef } { TFpPascalExpressionPartOperatorMakeRef }
procedure TFpGDBMIExpressionPartOperatorMakeRef.Init; procedure TFpPascalExpressionPartOperatorMakeRef.Init;
begin begin
FPrecedence := 1; FPrecedence := 1;
inherited Init; inherited Init;
end; end;
{ TFpGDBMIExpressionPartOperatorDeRef } { TFpPascalExpressionPartOperatorDeRef }
procedure TFpGDBMIExpressionPartOperatorDeRef.Init; procedure TFpPascalExpressionPartOperatorDeRef.Init;
begin begin
FPrecedence := 1; FPrecedence := 1;
inherited Init; inherited Init;
end; end;
function TFpGDBMIExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function TFpPascalExpressionPartOperatorDeRef.MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; var AResult: TFpPascalExpressionPart): Boolean;
begin begin
Result := MaybeAddLeftOperand(APrevPart, AResult); Result := MaybeAddLeftOperand(APrevPart, AResult);
end; end;
function TFpGDBMIExpressionPartOperatorDeRef.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; function TFpPascalExpressionPartOperatorDeRef.FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart;
begin begin
Result := Self; Result := Self;
end; end;
function TFpGDBMIExpressionPartOperatorDeRef.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; function TFpPascalExpressionPartOperatorDeRef.IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean;
begin begin
Result := inherited IsValidAfterPart(APrevPart); Result := inherited IsValidAfterPart(APrevPart);
if not Result then if not Result then
@ -301,20 +301,20 @@ begin
// "Identifer" can hane a binary-op next. But it must be applied to the parent. // "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here. // So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it // If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpPascalExpressionPartOperator) then
Result := False; Result := False;
end; end;
{ TFpGDBMIExpressionPartRoundBracket } { TFpPascalExpressionPartRoundBracket }
procedure TFpGDBMIExpressionPartBracket.Init; procedure TFpPascalExpressionPartBracket.Init;
begin begin
inherited Init; inherited Init;
FIsClosed := False; FIsClosed := False;
FIsClosing := False; FIsClosing := False;
end; end;
procedure TFpGDBMIExpressionPartBracket.DoHandleEndOfExpression; procedure TFpPascalExpressionPartBracket.DoHandleEndOfExpression;
begin begin
if not IsClosed then begin if not IsClosed then begin
SetError('Bracket not closed'); SetError('Bracket not closed');
@ -323,12 +323,12 @@ begin
inherited DoHandleEndOfExpression; inherited DoHandleEndOfExpression;
end; end;
function TFpGDBMIExpressionPartBracket.CanHaveOperatorAsNext: Boolean; function TFpPascalExpressionPartBracket.CanHaveOperatorAsNext: Boolean;
begin begin
Result := IsClosed; Result := IsClosed;
end; end;
procedure TFpGDBMIExpressionPartBracket.CloseBracket; procedure TFpPascalExpressionPartBracket.CloseBracket;
begin begin
FIsClosing := True; FIsClosing := True;
if LastItem <> nil then if LastItem <> nil then
@ -337,7 +337,7 @@ begin
FIsClosed := True; FIsClosed := True;
end; end;
function TFpGDBMIExpressionPartBracket.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; function TFpPascalExpressionPartBracket.HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart;
begin begin
if IsClosed then begin if IsClosed then begin
Result := inherited HandleNextPart(APart); Result := inherited HandleNextPart(APart);
@ -354,28 +354,28 @@ begin
Add(APart); Add(APart);
end; end;
procedure TFpGDBMIExpressionPartBracket.HandleEndOfExpression; procedure TFpPascalExpressionPartBracket.HandleEndOfExpression;
begin begin
if not FIsClosing then if not FIsClosing then
inherited HandleEndOfExpression; inherited HandleEndOfExpression;
end; end;
{ TFpGDBMIExpressionPartOperatorUnaryPlusMinus } { TFpPascalExpressionPartOperatorUnaryPlusMinus }
procedure TFpGDBMIExpressionPartOperatorUnaryPlusMinus.Init; procedure TFpPascalExpressionPartOperatorUnaryPlusMinus.Init;
begin begin
FPrecedence := 1; FPrecedence := 1;
inherited Init; inherited Init;
end; end;
{ TFpGDBMIExpression } { TFpPascalExpression }
procedure TFpGDBMIExpression.Parse; procedure TFpPascalExpression.Parse;
var var
CurPtr, EndPtr, TokenEndPtr: PChar; CurPtr, EndPtr, TokenEndPtr: PChar;
CurPart, NewPart: TFpGDBMIExpressionPart; CurPart, NewPart: TFpPascalExpressionPart;
procedure AddPart(AClass: TFpGDBMIExpressionPartClass); procedure AddPart(AClass: TFpPascalExpressionPartClass);
begin begin
NewPart := AClass.Create(Self, CurPtr, TokenEndPtr-1); NewPart := AClass.Create(Self, CurPtr, TokenEndPtr-1);
end; end;
@ -383,8 +383,8 @@ var
procedure AddPlusMinus; procedure AddPlusMinus;
begin begin
if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext) if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext)
then AddPart(TFpGDBMIExpressionPartOperatorUnaryPlusMinus) then AddPart(TFpPascalExpressionPartOperatorUnaryPlusMinus)
else AddPart(TFpGDBMIExpressionPartOperatorPlusMinus); else AddPart(TFpPascalExpressionPartOperatorPlusMinus);
end; end;
procedure AddConstChar; procedure AddConstChar;
@ -400,7 +400,7 @@ var
while TokenEndPtr^ in ['a'..'z', 'A'..'Z', '_', '0'..'9'] do while TokenEndPtr^ in ['a'..'z', 'A'..'Z', '_', '0'..'9'] do
inc(TokenEndPtr); inc(TokenEndPtr);
// TODO: Check functions not, and, in, as, is ... // TODO: Check functions not, and, in, as, is ...
NewPart := TFpGDBMIExpressionPartIdentifer.Create(Self, CurPtr, TokenEndPtr-1); NewPart := TFpPascalExpressionPartIdentifer.Create(Self, CurPtr, TokenEndPtr-1);
end; end;
procedure HandleDot; procedure HandleDot;
@ -408,7 +408,7 @@ var
while TokenEndPtr^ = '.' do while TokenEndPtr^ = '.' do
inc(TokenEndPtr); inc(TokenEndPtr);
case TokenEndPtr - CurPtr of case TokenEndPtr - CurPtr of
1: AddPart(TFpGDBMIExpressionPartOperatorMemberOf); 1: AddPart(TFpPascalExpressionPartOperatorMemberOf);
//2: ; // ".." //2: ; // ".."
else SetError('Failed parsing ...'); else SetError('Failed parsing ...');
end; end;
@ -417,11 +417,11 @@ var
procedure AddRefOperator; procedure AddRefOperator;
begin begin
if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext) if (CurPart = nil) or (not CurPart.CanHaveOperatorAsNext)
then AddPart(TFpGDBMIExpressionPartOperatorMakeRef) then AddPart(TFpPascalExpressionPartOperatorMakeRef)
else AddPart(TFpGDBMIExpressionPartOperatorDeRef); else AddPart(TFpPascalExpressionPartOperatorDeRef);
end; end;
procedure CloseBracket(ABracketClass: TFpGDBMIExpressionPartBracketClass); procedure CloseBracket(ABracketClass: TFpPascalExpressionPartBracketClass);
begin begin
NewPart := CurPart.SurroundingBracket; NewPart := CurPart.SurroundingBracket;
if NewPart = nil then begin if NewPart = nil then begin
@ -432,7 +432,7 @@ var
SetError('Mismatch bracket') SetError('Mismatch bracket')
end end
else begin else begin
TFpGDBMIExpressionPartBracket(NewPart).CloseBracket; TFpPascalExpressionPartBracket(NewPart).CloseBracket;
CurPart := nil; CurPart := nil;
end; end;
end; end;
@ -454,13 +454,13 @@ begin
NewPart := nil; NewPart := nil;
TokenEndPtr := CurPtr + 1; TokenEndPtr := CurPtr + 1;
case CurPtr^ of case CurPtr^ of
'@' : AddPart(TFpGDBMIExpressionPartOperatorAddressOf); '@' : AddPart(TFpPascalExpressionPartOperatorAddressOf);
'^': AddRefOperator; '^': AddRefOperator;
'.': HandleDot; '.': HandleDot;
'+', '-' : AddPlusMinus; '+', '-' : AddPlusMinus;
'*', '/' : AddPart(TFpGDBMIExpressionPartOperatorMulDiv); '*', '/' : AddPart(TFpPascalExpressionPartOperatorMulDiv);
'(': AddPart(TFpGDBMIExpressionPartRoundBracket); '(': AddPart(TFpPascalExpressionPartRoundBracket);
')': CloseBracket(TFpGDBMIExpressionPartRoundBracket); ')': CloseBracket(TFpPascalExpressionPartRoundBracket);
//'[': ; //'[': ;
//'''': AddConstChar; //'''': AddConstChar;
//'0'..'9', //'0'..'9',
@ -496,47 +496,47 @@ begin
FExpressionPart := CurPart; FExpressionPart := CurPart;
end; end;
procedure TFpGDBMIExpression.SetError(AMsg: String); procedure TFpPascalExpression.SetError(AMsg: String);
begin begin
FValid := False; FValid := False;
FError := AMsg; FError := AMsg;
end; end;
function TFpGDBMIExpression.PosFromPChar(APChar: PChar): Integer; function TFpPascalExpression.PosFromPChar(APChar: PChar): Integer;
begin begin
Result := APChar - @FTextExpression[1] + 1; Result := APChar - @FTextExpression[1] + 1;
end; end;
constructor TFpGDBMIExpression.Create(ATextExpression: String); constructor TFpPascalExpression.Create(ATextExpression: String);
begin begin
FTextExpression := ATextExpression; FTextExpression := ATextExpression;
FValid := True; FValid := True;
Parse; Parse;
end; end;
destructor TFpGDBMIExpression.Destroy; destructor TFpPascalExpression.Destroy;
begin begin
FreeAndNil(FExpressionPart); FreeAndNil(FExpressionPart);
inherited Destroy; inherited Destroy;
end; end;
function TFpGDBMIExpression.DebugDump: String; function TFpPascalExpression.DebugDump: String;
begin begin
Result := 'TFpGDBMIExpression: ' + FTextExpression + LineEnding + Result := 'TFpPascalExpression: ' + FTextExpression + LineEnding +
'Valid: ' + dbgs(FValid) + ' Error: "' + FError + '"'+ LineEnding 'Valid: ' + dbgs(FValid) + ' Error: "' + FError + '"'+ LineEnding
; ;
if FExpressionPart <> nil then if FExpressionPart <> nil then
Result := Result + FExpressionPart.DebugDump(' '); Result := Result + FExpressionPart.DebugDump(' ');
end; end;
{ TFpGDBMIExpressionPartContainer } { TFpPascalExpressionPartContainer }
function TFpGDBMIExpressionPartContainer.GetItems(AIndex: Integer): TFpGDBMIExpressionPart; function TFpPascalExpressionPartContainer.GetItems(AIndex: Integer): TFpPascalExpressionPart;
begin begin
Result := TFpGDBMIExpressionPart(FList[AIndex]); Result := TFpPascalExpressionPart(FList[AIndex]);
end; end;
function TFpGDBMIExpressionPartContainer.GetLastItem: TFpGDBMIExpressionPart; function TFpPascalExpressionPartContainer.GetLastItem: TFpPascalExpressionPart;
begin begin
if Count > 0 then if Count > 0 then
Result := Items[Count - 1] Result := Items[Count - 1]
@ -544,26 +544,26 @@ begin
Result := nil; Result := nil;
end; end;
procedure TFpGDBMIExpressionPartContainer.SetItems(AIndex: Integer; procedure TFpPascalExpressionPartContainer.SetItems(AIndex: Integer;
AValue: TFpGDBMIExpressionPart); AValue: TFpPascalExpressionPart);
begin begin
AValue.Parent := Self; AValue.Parent := Self;
FList[AIndex] := AValue; FList[AIndex] := AValue;
end; end;
procedure TFpGDBMIExpressionPartContainer.SetLastItem(AValue: TFpGDBMIExpressionPart); procedure TFpPascalExpressionPartContainer.SetLastItem(AValue: TFpPascalExpressionPart);
begin begin
assert(Count >0); assert(Count >0);
Items[Count-1] := AValue; Items[Count-1] := AValue;
end; end;
procedure TFpGDBMIExpressionPartContainer.Init; procedure TFpPascalExpressionPartContainer.Init;
begin begin
FList := TList.Create; FList := TList.Create;
inherited Init; inherited Init;
end; end;
function TFpGDBMIExpressionPartContainer.DebugDump(AIndent: String): String; function TFpPascalExpressionPartContainer.DebugDump(AIndent: String): String;
var var
i: Integer; i: Integer;
begin begin
@ -572,32 +572,32 @@ begin
Result := Result + Items[i].DebugDump(AIndent+' '); Result := Result + Items[i].DebugDump(AIndent+' ');
end; end;
function TFpGDBMIExpressionPartContainer.GetCount: Integer; function TFpPascalExpressionPartContainer.GetCount: Integer;
begin begin
Result := FList.Count; Result := FList.Count;
end; end;
destructor TFpGDBMIExpressionPartContainer.Destroy; destructor TFpPascalExpressionPartContainer.Destroy;
begin begin
Clear; Clear;
FreeAndNil(FList); FreeAndNil(FList);
inherited Destroy; inherited Destroy;
end; end;
function TFpGDBMIExpressionPartContainer.Add(APart: TFpGDBMIExpressionPart): Integer; function TFpPascalExpressionPartContainer.Add(APart: TFpPascalExpressionPart): Integer;
begin begin
APart.Parent := Self; APart.Parent := Self;
Result := FList.Add(APart); Result := FList.Add(APart);
end; end;
function TFpGDBMIExpressionPartContainer.IndexOf(APart: TFpGDBMIExpressionPart): Integer; function TFpPascalExpressionPartContainer.IndexOf(APart: TFpPascalExpressionPart): Integer;
begin begin
Result := Count - 1; Result := Count - 1;
while (Result >= 0) and (Items[Result] <> APart) do while (Result >= 0) and (Items[Result] <> APart) do
dec(Result); dec(Result);
end; end;
procedure TFpGDBMIExpressionPartContainer.Clear; procedure TFpPascalExpressionPartContainer.Clear;
begin begin
while Count > 0 do begin while Count > 0 do begin
Items[0].Free; Items[0].Free;
@ -605,49 +605,49 @@ begin
end; end;
end; end;
{ TFpGDBMIExpressionPart } { TFpPascalExpressionPart }
procedure TFpGDBMIExpressionPart.SetEndChar(AValue: PChar); procedure TFpPascalExpressionPart.SetEndChar(AValue: PChar);
begin begin
if FEndChar = AValue then Exit; if FEndChar = AValue then Exit;
FEndChar := AValue; FEndChar := AValue;
end; end;
function TFpGDBMIExpressionPart.GetTopParent: TFpGDBMIExpressionPart; function TFpPascalExpressionPart.GetTopParent: TFpPascalExpressionPart;
begin begin
Result := Self; Result := Self;
while Result.Parent <> nil do while Result.Parent <> nil do
Result := Result.Parent; Result := Result.Parent;
end; end;
function TFpGDBMIExpressionPart.GetSurroundingBracket: TFpGDBMIExpressionPartBracket; function TFpPascalExpressionPart.GetSurroundingBracket: TFpPascalExpressionPartBracket;
var var
tmp: TFpGDBMIExpressionPart; tmp: TFpPascalExpressionPart;
begin begin
Result := nil; Result := nil;
tmp := Self; tmp := Self;
while (tmp <> nil) and not(tmp is TFpGDBMIExpressionPartBracket) do while (tmp <> nil) and not(tmp is TFpPascalExpressionPartBracket) do
tmp := tmp.Parent; tmp := tmp.Parent;
if tmp <> nil then if tmp <> nil then
Result := TFpGDBMIExpressionPartBracket(tmp); Result := TFpPascalExpressionPartBracket(tmp);
end; end;
procedure TFpGDBMIExpressionPart.SetParent(AValue: TFpGDBMIExpressionPartContainer); procedure TFpPascalExpressionPart.SetParent(AValue: TFpPascalExpressionPartContainer);
var var
Old: TFpGDBMIExpressionPart; Old: TFpPascalExpressionPart;
begin begin
if FParent = AValue then Exit; if FParent = AValue then Exit;
Old := FParent; Old := FParent;
FParent := AValue; FParent := AValue;
end; end;
procedure TFpGDBMIExpressionPart.SetStartChar(AValue: PChar); procedure TFpPascalExpressionPart.SetStartChar(AValue: PChar);
begin begin
if FStartChar = AValue then Exit; if FStartChar = AValue then Exit;
FStartChar := AValue; FStartChar := AValue;
end; end;
function TFpGDBMIExpressionPart.GetText(AMaxLen: Integer): String; function TFpPascalExpressionPart.GetText(AMaxLen: Integer): String;
var var
Len: Integer; Len: Integer;
begin begin
@ -659,26 +659,26 @@ begin
Result := Copy(FStartChar, 1, Len); Result := Copy(FStartChar, 1, Len);
end; end;
procedure TFpGDBMIExpressionPart.SetError(AMsg: String); procedure TFpPascalExpressionPart.SetError(AMsg: String);
begin begin
if AMsg = '' then if AMsg = '' then
AMsg := 'Invalid Expression'; AMsg := 'Invalid Expression';
FExpression.SetError(Format('%0:s at %1:d: "%2:s"', [AMsg, FExpression.PosFromPChar(FStartChar), GetText(20)])); FExpression.SetError(Format('%0:s at %1:d: "%2:s"', [AMsg, FExpression.PosFromPChar(FStartChar), GetText(20)]));
end; end;
procedure TFpGDBMIExpressionPart.SetError(APart: TFpGDBMIExpressionPart; AMsg: String); procedure TFpPascalExpressionPart.SetError(APart: TFpPascalExpressionPart; AMsg: String);
begin begin
if APart <> nil if APart <> nil
then APart.SetError(AMsg) then APart.SetError(AMsg)
else Self.SetError(AMsg); else Self.SetError(AMsg);
end; end;
procedure TFpGDBMIExpressionPart.Init; procedure TFpPascalExpressionPart.Init;
begin begin
// //
end; end;
procedure TFpGDBMIExpressionPart.ReplaceInParent(AReplacement: TFpGDBMIExpressionPart); procedure TFpPascalExpressionPart.ReplaceInParent(AReplacement: TFpPascalExpressionPart);
var var
i: Integer; i: Integer;
begin begin
@ -689,50 +689,50 @@ begin
Parent := nil; Parent := nil;
end; end;
procedure TFpGDBMIExpressionPart.DoHandleEndOfExpression; procedure TFpPascalExpressionPart.DoHandleEndOfExpression;
begin begin
// //
end; end;
function TFpGDBMIExpressionPart.IsValidNextPart(APart: TFpGDBMIExpressionPart): Boolean; function TFpPascalExpressionPart.IsValidNextPart(APart: TFpPascalExpressionPart): Boolean;
begin begin
Result := APart.IsValidAfterPart(Self); Result := APart.IsValidAfterPart(Self);
end; end;
function TFpGDBMIExpressionPart.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; function TFpPascalExpressionPart.IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean;
begin begin
Result := True; Result := True;
end; end;
function TFpGDBMIExpressionPart.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function TFpPascalExpressionPart.MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; var AResult: TFpPascalExpressionPart): Boolean;
begin begin
Result := False; Result := False;
end; end;
function TFpGDBMIExpressionPart.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; function TFpPascalExpressionPart.FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart;
begin begin
Result := Self; Result := Self;
end; end;
function TFpGDBMIExpressionPart.CanHaveOperatorAsNext: Boolean; function TFpPascalExpressionPart.CanHaveOperatorAsNext: Boolean;
begin begin
Result := True; Result := True;
end; end;
function TFpGDBMIExpressionPart.DebugText(AIndent: String): String; function TFpPascalExpressionPart.DebugText(AIndent: String): String;
begin begin
Result := Format('%s%s at %d: "%s"', Result := Format('%s%s at %d: "%s"',
[AIndent, ClassName, FExpression.PosFromPChar(FStartChar), GetText]) [AIndent, ClassName, FExpression.PosFromPChar(FStartChar), GetText])
+ LineEnding; + LineEnding;
end; end;
function TFpGDBMIExpressionPart.DebugDump(AIndent: String): String; function TFpPascalExpressionPart.DebugDump(AIndent: String): String;
begin begin
Result := DebugText(AIndent); Result := DebugText(AIndent);
end; end;
constructor TFpGDBMIExpressionPart.Create(AExpression: TFpGDBMIExpression; AStartChar: PChar; constructor TFpPascalExpressionPart.Create(AExpression: TFpPascalExpression; AStartChar: PChar;
AnEndChar: PChar); AnEndChar: PChar);
begin begin
FExpression := AExpression; FExpression := AExpression;
@ -741,7 +741,7 @@ begin
Init; Init;
end; end;
function TFpGDBMIExpressionPart.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; function TFpPascalExpressionPart.HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart;
begin begin
Result := APart; Result := APart;
if APart.MaybeHandlePrevPart(Self, Result) then if APart.MaybeHandlePrevPart(Self, Result) then
@ -757,16 +757,16 @@ begin
Result := Self; Result := Self;
end; end;
procedure TFpGDBMIExpressionPart.HandleEndOfExpression; procedure TFpPascalExpressionPart.HandleEndOfExpression;
begin begin
DoHandleEndOfExpression; DoHandleEndOfExpression;
if Parent <> nil then if Parent <> nil then
Parent.HandleEndOfExpression; Parent.HandleEndOfExpression;
end; end;
{ TFpGDBMIExpressionPartOperator } { TFpPascalExpressionPartOperator }
function TFpGDBMIExpressionPartOperator.DebugText(AIndent: String): String; function TFpPascalExpressionPartOperator.DebugText(AIndent: String): String;
begin begin
Result := inherited DebugText(AIndent); Result := inherited DebugText(AIndent);
while Result[Length(Result)] in [#10, #13] do SetLength(Result, Length(Result)-1); while Result[Length(Result)] in [#10, #13] do SetLength(Result, Length(Result)-1);
@ -774,12 +774,12 @@ begin
LineEnding; LineEnding;
end; end;
function TFpGDBMIExpressionPartOperator.CanHaveOperatorAsNext: Boolean; function TFpPascalExpressionPartOperator.CanHaveOperatorAsNext: Boolean;
begin begin
Result := HasAllOperands and LastItem.CanHaveOperatorAsNext; Result := HasAllOperands and LastItem.CanHaveOperatorAsNext;
end; end;
function TFpGDBMIExpressionPartOperator.FindLeftSideOperandByPrecedence(AnOperator: TFpGDBMIExpressionPartOperator): TFpGDBMIExpressionPart; function TFpPascalExpressionPartOperator.FindLeftSideOperandByPrecedence(AnOperator: TFpPascalExpressionPartOperator): TFpPascalExpressionPart;
begin begin
Result := Self; Result := Self;
@ -793,10 +793,10 @@ begin
Result := LastItem.FindLeftSideOperandByPrecedence(AnOperator); Result := LastItem.FindLeftSideOperandByPrecedence(AnOperator);
end; end;
function TFpGDBMIExpressionPartOperator.MaybeAddLeftOperand(APrevPart: TFpGDBMIExpressionPart; function TFpPascalExpressionPartOperator.MaybeAddLeftOperand(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; var AResult: TFpPascalExpressionPart): Boolean;
var var
ALeftSide: TFpGDBMIExpressionPart; ALeftSide: TFpPascalExpressionPart;
begin begin
Result := APrevPart.IsValidNextPart(Self); Result := APrevPart.IsValidNextPart(Self);
if not Result then if not Result then
@ -822,7 +822,7 @@ begin
Add(ALeftSide); Add(ALeftSide);
end; end;
procedure TFpGDBMIExpressionPartOperator.DoHandleEndOfExpression; procedure TFpPascalExpressionPartOperator.DoHandleEndOfExpression;
begin begin
if not HasAllOperands then if not HasAllOperands then
SetError(Self, 'Not enough operands') SetError(Self, 'Not enough operands')
@ -830,7 +830,7 @@ begin
inherited DoHandleEndOfExpression; inherited DoHandleEndOfExpression;
end; end;
function TFpGDBMIExpressionPartOperator.HandleNextPart(APart: TFpGDBMIExpressionPart): TFpGDBMIExpressionPart; function TFpPascalExpressionPartOperator.HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart;
begin begin
Result := Self; Result := Self;
if HasAllOperands then begin if HasAllOperands then begin
@ -847,21 +847,21 @@ begin
Result := APart; Result := APart;
end; end;
{ TFpGDBMIExpressionPartUnaryOperator } { TFpPascalExpressionPartUnaryOperator }
function TFpGDBMIExpressionPartUnaryOperator.HasAllOperands: Boolean; function TFpPascalExpressionPartUnaryOperator.HasAllOperands: Boolean;
begin begin
Result := Count = 1; Result := Count = 1;
end; end;
{ TFpGDBMIExpressionPartBinaryOperator } { TFpPascalExpressionPartBinaryOperator }
function TFpGDBMIExpressionPartBinaryOperator.HasAllOperands: Boolean; function TFpPascalExpressionPartBinaryOperator.HasAllOperands: Boolean;
begin begin
Result := Count = 2; Result := Count = 2;
end; end;
function TFpGDBMIExpressionPartBinaryOperator.IsValidAfterPart(APrevPart: TFpGDBMIExpressionPart): Boolean; function TFpPascalExpressionPartBinaryOperator.IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean;
begin begin
Result := inherited IsValidAfterPart(APrevPart); Result := inherited IsValidAfterPart(APrevPart);
if not Result then if not Result then
@ -875,35 +875,35 @@ begin
// "Identifer" can hane a binary-op next. But it must be applied to the parent. // "Identifer" can hane a binary-op next. But it must be applied to the parent.
// So it is not valid here. // So it is not valid here.
// If new operator has a higher precedence, it go down to the child again and replace it // If new operator has a higher precedence, it go down to the child again and replace it
if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpGDBMIExpressionPartOperator) then if (APrevPart.Parent <> nil) and (APrevPart.Parent is TFpPascalExpressionPartOperator) then
Result := False; Result := False;
end; end;
function TFpGDBMIExpressionPartBinaryOperator.MaybeHandlePrevPart(APrevPart: TFpGDBMIExpressionPart; function TFpPascalExpressionPartBinaryOperator.MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
var AResult: TFpGDBMIExpressionPart): Boolean; var AResult: TFpPascalExpressionPart): Boolean;
begin begin
Result := MaybeAddLeftOperand(APrevPart, AResult); Result := MaybeAddLeftOperand(APrevPart, AResult);
end; end;
{ TFpGDBMIExpressionPartOperatorAddressOf } { TFpPascalExpressionPartOperatorAddressOf }
procedure TFpGDBMIExpressionPartOperatorAddressOf.Init; procedure TFpPascalExpressionPartOperatorAddressOf.Init;
begin begin
FPrecedence := 1; // highest FPrecedence := 1; // highest
inherited Init; inherited Init;
end; end;
{ TFpGDBMIExpressionPartOperatorPlusMinus } { TFpPascalExpressionPartOperatorPlusMinus }
procedure TFpGDBMIExpressionPartOperatorPlusMinus.Init; procedure TFpPascalExpressionPartOperatorPlusMinus.Init;
begin begin
FPrecedence := 3; FPrecedence := 3;
inherited Init; inherited Init;
end; end;
{ TFpGDBMIExpressionPartOperatorMulDiv } { TFpPascalExpressionPartOperatorMulDiv }
procedure TFpGDBMIExpressionPartOperatorMulDiv.Init; procedure TFpPascalExpressionPartOperatorMulDiv.Init;
begin begin
FPrecedence := 2; FPrecedence := 2;
inherited Init; inherited Init;

84
components/fpdebug/test/FpTest.lpi Normal file
View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="FpTest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="fpdebug"/>
</Item1>
<Item2>
<PackageName Value="FPCUnitTestRunner"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="FpTest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FpTest"/>
</Unit0>
<Unit1>
<Filename Value="testpascalparser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestPascalParser"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

15
components/fpdebug/test/FpTest.lpr Normal file
View File

@ -0,0 +1,15 @@
program FpTest;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner, TestPascalParser;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

221
components/fpdebug/test/testpascalparser.pas Normal file
View File

@ -0,0 +1,221 @@
unit TestPascalParser;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, FpPascalParser;
type
{ TTestPascalParser }
TTestPascalParser = class(TTestCase)
published
procedure TestParser;
end;
implementation
type
{ TTestFpPascalExpression }
TTestFpPascalExpression=class(TFpPascalExpression)
public
property ExpressionPart;
end;
{ TTestFpPascalExpression }
procedure TTestPascalParser.TestParser;
var
CurrentTestExprText: String;
CurrentTestExprObj: TTestFpPascalExpression;
Procedure TestExpr(APart: TFpPascalExpressionPart; AClass: TFpPascalExpressionPartClass;
AText: String; AChildCount: Integer = -1);
begin
AssertNotNull(CurrentTestExprText+ ': IsAssigned', APart);
AssertTrue(CurrentTestExprText+': APart IS Class exp: '+AClass.ClassName+' was: '+APart.ClassName,
APart is AClass);
AssertEquals(CurrentTestExprText+': Text', AText, APart.GetText);
if AChildCount >=0 then begin
AssertTrue(CurrentTestExprText+': Is container ', APart is TFpPascalExpressionPartContainer);
AssertEquals(CurrentTestExprText+': childcount ', AChildCount, (APart as TFpPascalExpressionPartContainer).Count);
end;
end;
procedure CreateExpr(t: string; ExpValid: Boolean);
begin
FreeAndNil(CurrentTestExprObj);
CurrentTestExprText := t;
CurrentTestExprObj := TTestFpPascalExpression.Create(CurrentTestExprText);
AssertEquals('Valid '+CurrentTestExprObj.Error+ ' # '+CurrentTestExprText, ExpValid, CurrentTestExprObj.Valid);
end;
function GetChild(p: TFpPascalExpressionPart; i: array of integer): TFpPascalExpressionPart;
var
j: Integer;
begin
Result := p;
for j := low(i) to high(i) do
Result := (Result as TFpPascalExpressionPartContainer).Items[i[j]];
end;
begin
CurrentTestExprObj := nil;
try
CreateExpr('a', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('a b', False);
CreateExpr('@a', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('a@', False);
CreateExpr('-a', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('+-a', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorUnaryPlusMinus, '+', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('a+b', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartIdentifer, 'b', 0);
CreateExpr('a+', False);
CreateExpr('a*', False);
CreateExpr('a+b-', False);
CreateExpr('a@+b', False);
CreateExpr('a+-b', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartIdentifer, 'b', 0);
CreateExpr('+a + -@b - @+c', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '-', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartOperatorUnaryPlusMinus,'+', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1,0]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1,0,0]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '+', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0,0]), TFpPascalExpressionPartIdentifer, 'c', 0);
CreateExpr('a+b*c', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,1]), TFpPascalExpressionPartIdentifer, 'c', 0);
CreateExpr('a*b+c', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartIdentifer, 'c', 0);
CreateExpr('a*b+c*d', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartIdentifer, 'c', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,1]), TFpPascalExpressionPartIdentifer, 'd', 0);
CreateExpr('@a*@b+@c', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1,0]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartIdentifer, 'c', 0);
CreateExpr('@a*@b+@c*@d', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartOperatorPlusMinus, '+', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1,0]), TFpPascalExpressionPartIdentifer, 'b', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,0,0]), TFpPascalExpressionPartIdentifer, 'c', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,1]), TFpPascalExpressionPartOperatorAddressOf, '@', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1,1,0]), TFpPascalExpressionPartIdentifer, 'd', 0);
CreateExpr('(a)', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('a)', False);
CreateExpr('(a', False);
CreateExpr(')', False);
CreateExpr('(', False);
CreateExpr('(-a)', True);
TestExpr(CurrentTestExprObj.ExpressionPart, TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('-(-a)', True);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, []), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
CreateExpr('(a*b)', True);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, []), TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartIdentifer, 'b', 0);
CreateExpr('(-a*b)', True);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, []), TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartOperatorUnaryPlusMinus, '-', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,1]), TFpPascalExpressionPartIdentifer, 'b', 0);
CreateExpr('(a)*b', True);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, []), TFpPascalExpressionPartOperatorMulDiv, '*', 2);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0]), TFpPascalExpressionPartRoundBracket, '(', 1);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [0,0]), TFpPascalExpressionPartIdentifer, 'a', 0);
TestExpr(GetChild(CurrentTestExprObj.ExpressionPart, [1]), TFpPascalExpressionPartIdentifer, 'b', 0);
CreateExpr('(a+b)*c', True);
CreateExpr('(@a)*@c', True);
CreateExpr('(@a+@b)*@c', True);
finally
CurrentTestExprObj.Free;
end;
end;
initialization
RegisterTest(TTestPascalParser);
end.