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

FpDebug: flatten intrinsic, fixes for use with slices (no cache)

Browse Source
This commit is contained in:
Martin 2024-07-24 17:21:33 +02:00
parent 9c975dcca8
commit da812e6d12
1 changed files with 33 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/fpdebug/fppascalparser.pas
View File

@ -175,7 +175,7 @@ type
procedure Init; virtual; procedure Init; virtual;
function DoGetIsTypeCast: Boolean; virtual; deprecated; function DoGetIsTypeCast: Boolean; virtual; deprecated;
function DoGetResultValue: TFpValue; virtual; function DoGetResultValue: TFpValue; virtual;
procedure ResetEvaluation; procedure ResetEvaluation; virtual;
procedure ResetEvaluationRecursive; virtual; procedure ResetEvaluationRecursive; virtual;
procedure ResetEvaluationForAnchestors; virtual; procedure ResetEvaluationForAnchestors; virtual;
@ -207,6 +207,7 @@ type
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: TFpPascalExpressionPartContainer read FParent write SetParent; property Parent: TFpPascalExpressionPartContainer read FParent write SetParent;
function FindInParents(APart: TFpPascalExpressionPart): Boolean;
property TopParent: TFpPascalExpressionPart read GetTopParent; // or self property TopParent: TFpPascalExpressionPart read GetTopParent; // or self
property Precedence: Integer read FPrecedence; property Precedence: Integer read FPrecedence;
property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingOpenBracket; // incl self property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingOpenBracket; // incl self
@ -643,7 +644,7 @@ type
function GetCanDisableSlice: boolean; function GetCanDisableSlice: boolean;
protected protected
function DoGetResultValue: TFpValue; override; function DoGetResultValue: TFpValue; override;
procedure ResetEvaluation; procedure ResetEvaluation; override;
procedure ResetEvaluationForIndex; procedure ResetEvaluationForIndex;
procedure ResetEvaluationForAnchestors; override; procedure ResetEvaluationForAnchestors; override;
public public
@ -652,6 +653,7 @@ type
ATopPart: TFpPascalExpressionPart; ATopPart: TFpPascalExpressionPart;
AStartChar: PChar; AnEndChar: PChar = nil); AStartChar: PChar; AnEndChar: PChar = nil);
function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override; function HandleNextPart(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
property SlicePart: TFpPascalExpressionPartOperatorArraySlice read FSlicePart;
property DisableSlice: boolean read FDisableSlice write FDisableSlice; property DisableSlice: boolean read FDisableSlice write FDisableSlice;
property CanDisableSlice: boolean read GetCanDisableSlice; property CanDisableSlice: boolean read GetCanDisableSlice;
end; end;
@ -2258,6 +2260,9 @@ end;
function TFpPascalExpressionPartIntrinsic.DoGetMemberForFlattenExpr( function TFpPascalExpressionPartIntrinsic.DoGetMemberForFlattenExpr(
APart: TFpPascalExpressionPart; AnIdent: String): TFpValue; APart: TFpPascalExpressionPart; AnIdent: String): TFpValue;
begin begin
if FFlattenCurrentVal = nil then
exit(nil);
Result := FFlattenCurrentVal.MemberByName[AnIdent]; Result := FFlattenCurrentVal.MemberByName[AnIdent];
if Result = nil then begin if Result = nil then begin
SetError(fpErrNoMemberWithName, [AnIdent]); SetError(fpErrNoMemberWithName, [AnIdent]);
@ -2859,7 +2864,7 @@ var
OptSet: TFpPascalExpressionPartBracketSet absolute LastParam; OptSet: TFpPascalExpressionPartBracketSet absolute LastParam;
i: Integer; i: Integer;
OName: String; OName: String;
OVal, CustomMaxCnt, LastParamNeg: Boolean; OVal, CustomMaxCnt, LastParamNeg, SkipCache: Boolean;
PParent: TFpPascalExpressionPartContainer; PParent: TFpPascalExpressionPartContainer;
ListCache: TFpPascalExpressionCacheFlatten; ListCache: TFpPascalExpressionCacheFlatten;
begin begin
@ -2946,7 +2951,17 @@ begin
end; end;
ListCache := nil; ListCache := nil;
SkipCache := False;
if (FExpression.GlobalCache <> nil) then begin if (FExpression.GlobalCache <> nil) then begin
Itm := TopParent;
while (not SkipCache) and (Itm is TFpPascalExpressionPartOperatorArraySliceController)
do begin
SkipCache := TFpPascalExpressionPartOperatorArraySliceController(Itm).SlicePart.FindInParents(Self.Parent);
Itm := TFpPascalExpressionPartContainer(Itm).Items[0];
end;
end;
if (not SkipCache) and (FExpression.GlobalCache <> nil) then begin
CacheKey.CtxThread := FExpression.Scope.LocationContext.ThreadId; CacheKey.CtxThread := FExpression.Scope.LocationContext.ThreadId;
CacheKey.CtxStack := FExpression.Scope.LocationContext.StackFrame; CacheKey.CtxStack := FExpression.Scope.LocationContext.StackFrame;
CacheKey.Flags := Flags; CacheKey.Flags := Flags;
@ -3012,7 +3027,7 @@ begin
Seen.Free; Seen.Free;
end; end;
if (FExpression.GlobalCache <> nil) then begin if (not SkipCache) and (FExpression.GlobalCache <> nil) then begin
if ListCache = nil then begin if ListCache = nil then begin
ListCache := TFpPascalExpressionCacheFlatten.Create; ListCache := TFpPascalExpressionCacheFlatten.Create;
FExpression.GlobalCache[Pointer(TFpPascalExpressionPartIntrinsic)] := ListCache; FExpression.GlobalCache[Pointer(TFpPascalExpressionPartIntrinsic)] := ListCache;
@ -4352,6 +4367,20 @@ begin
Result := (FResultValue.Flags * [vfVariant, vfArrayOfVariant] <> []); Result := (FResultValue.Flags * [vfVariant, vfArrayOfVariant] <> []);
end; end;
function TFpPascalExpressionPart.FindInParents(APart: TFpPascalExpressionPart): Boolean;
var
p: TFpPascalExpressionPart;
begin
p := Self;
while p <> nil do begin
Result := APart = p;
if Result then
exit;
p := p.Parent;
end;
Result := False;
end;
procedure TFpPascalExpressionPart.SetError(AMsg: String); procedure TFpPascalExpressionPart.SetError(AMsg: String);
begin begin
if AMsg = '' then if AMsg = '' then