diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index ecfae26a3d..a1188752cc 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -119,8 +119,11 @@ type FFlags: TFpValueFlags; FLastError: TFpError; FSize: TFpDbgValueSize; + FName: String; procedure SetAsString(AStartIndex, ALen: Int64; AValue: AnsiString); protected + procedure SetName(AValue: String); virtual; + function GetName: String; virtual; function GetKind: TDbgSymbolKind; virtual; function GetFieldFlags: TFpValueFieldFlags; virtual; @@ -179,6 +182,7 @@ type function GetSubWideString(AStartIndex, ALen: Int64; out ASubStr: WideString; AIgnoreBounds: Boolean = False): Boolean; virtual; // Kind: determines which types of value are available + property Name: String read GetName write SetName; property Kind: TDbgSymbolKind read GetKind; property Flags: TFpValueFlags read FFlags write FFlags; property FieldFlags: TFpValueFieldFlags read GetFieldFlags; @@ -406,7 +410,7 @@ type TFpValueConstEnumValue = class(TFpValueConstWithType) private - FName: String; + FEnumName: String; protected function GetFieldFlags: TFpValueFieldFlags; override; function GetKind: TDbgSymbolKind; override; @@ -430,6 +434,22 @@ type destructor Destroy; override; end; + { TFpValueConstStruct } + + TFpValueConstStruct = class(TFpValueConstWithType) + private + FList: TRefCntObjList; + protected + function GetKind: TDbgSymbolKind; override; + function GetMember(AIndex: Int64): TFpValue; override; + function GetMemberByName(const AnIndex: String): TFpValue; override; + function GetMemberCount: Integer; override; + protected + public + destructor Destroy; override; + procedure AddMember(AName: String; AMember: TFpValue); + end; + TFpDbgSymbolScope = class; { TFpSymbol } @@ -1204,6 +1224,24 @@ begin end; +procedure TFpValue.SetName(AValue: String); +begin + FName := AValue; +end; + +function TFpValue.GetName: String; +var + sym: TFpSymbol; +begin + if FName <> '' then + exit(FName); + sym := DbgSymbol; + if sym <> nil then + Result := sym.Name + else + Result := ''; +end; + procedure TFpValue.Reset; begin FEvalFlags := []; @@ -1551,13 +1589,13 @@ end; function TFpValueConstEnumValue.GetAsString: AnsiString; begin - Result := FName; + Result := FEnumName; end; constructor TFpValueConstEnumValue.Create(AName: String); begin inherited Create; - FName := AName; + FEnumName := AName; end; { TFpValueConstSet } @@ -1595,6 +1633,61 @@ begin FNames.Free; end; +{ TFpValueConstStruct } + +function TFpValueConstStruct.GetKind: TDbgSymbolKind; +begin + Result := skRecord; +end; + +function TFpValueConstStruct.GetMember(AIndex: Int64): TFpValue; +begin + if (FList = nil) or (AIndex >= FList.Count) then + exit(nil); + Result := TFpValue(FList[AIndex]); + Result.AddReference; +end; + +function TFpValueConstStruct.GetMemberByName(const AnIndex: String): TFpValue; +var + n: String; + i: Integer; +begin + n := LowerCase(AnIndex); + if (FList = nil) then + exit(nil); + for i := 0 to FList.Count - 1 do begin + Result := TFpValue(FList[i]); + if LowerCase(Result.Name) = n then begin + Result.AddReference; + exit; + end; + end; + Result := nil; +end; + +function TFpValueConstStruct.GetMemberCount: Integer; +begin + if FList <> nil then + Result := FList.Count + else + Result := 0; +end; + +destructor TFpValueConstStruct.Destroy; +begin + FList.Free; + inherited Destroy; +end; + +procedure TFpValueConstStruct.AddMember(AName: String; AMember: TFpValue); +begin + if FList = nil then + FList := TRefCntObjList.Create; + AMember.Name := AName; + FList.Add(AMember); +end; + { TFpValueConstArray } function TFpValueConstArray.GetKind: TDbgSymbolKind; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index c3084a80ac..53d4f6aad8 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -2506,7 +2506,8 @@ type iffShowRecurse, iffShowSeen, iffShowErrAny, - iffDerefPtr + iffDerefPtr, + iffObj1, iffObj2, iffObj3, iffObj4 ); TFpPascalExpressionFlattenFlags = set of TFpPascalExpressionFlattenFlag; @@ -2672,6 +2673,7 @@ var TpSym: TFpSymbol; CacheKey: TFpPascalExpressionCacheFlattenKey; + procedure AddErrToList(AnErr: TFpError); var E: TFpValueConstError; @@ -2681,10 +2683,60 @@ var E.ReleaseReference end; - function FlattenRecurse(ACurrentVal: TFpValue): boolean; forward; - function FlattenArray(ACurrentVal: TFpValue; AnExpandDepth: integer): boolean; forward; + function FlattenRecurse(ACurrentVal: TFpValue; ACurDepth: integer; ACurKey: String): boolean; forward; + function FlattenArray(ACurrentVal: TFpValue; ACurDepth, ACurKeyIdx: integer; ACurKey: String; + AnExpandDepth: integer): boolean; forward; - function AddFlatValue(ACurrentVal: TFpValue; AnExpandDepth: integer): boolean; + function InternalAdd(ACurrentVal: TFpValue; ACurDepth, ACurKeyIdx: integer; ACurKey: String): Integer; + var + TmpVal: TFpValueConstStruct; + TmpVal2: TFpValue; + begin + if iffObj1 in Flags then begin + TmpVal := TFpValueConstStruct.Create; + TmpVal2 := TFpValueConstNumber.Create(ACurDepth, False); + TmpVal.AddMember('d', TmpVal2); + TmpVal2.ReleaseReference; + + TmpVal2 := TFpValueConstString.Create(ACurKey); + TmpVal.AddMember('k', TmpVal2); + TmpVal2.ReleaseReference; + + TmpVal.AddMember('v', ACurrentVal); + Result := Res.FList.Add(TmpVal); + TmpVal.ReleaseReference; + end + else + if iffObj2 in Flags then begin + TmpVal := TFpValueConstStruct.Create; + TmpVal2 := TFpValueConstNumber.Create(ACurDepth, False); + TmpVal.AddMember('d', TmpVal2); + TmpVal2.ReleaseReference; + + TmpVal2 := TFpValueConstNumber.Create(QWord(ACurKeyIdx), True); + TmpVal.AddMember('k', TmpVal2); + TmpVal2.ReleaseReference; + + TmpVal.AddMember('v', ACurrentVal); + Result := Res.FList.Add(TmpVal); + TmpVal.ReleaseReference; + end + else + if Flags * [iffObj3, iffObj4] <> [] then begin + TmpVal := TFpValueConstStruct.Create; + TmpVal2 := TFpValueConstString.Create(ACurKey); + TmpVal.AddMember('k', TmpVal2); + TmpVal2.ReleaseReference; + + TmpVal.AddMember('v', ACurrentVal); + Result := Res.FList.Add(TmpVal); + TmpVal.ReleaseReference; + end + else + Result := Res.FList.Add(ACurrentVal); + end; + + function AddFlatValue(ACurrentVal: TFpValue; ACurDepth, ACurKeyIdx: integer; ACurKey: String; AnExpandDepth: integer): boolean; var s, ResIdx, SeenIdx, ValIdx: Integer; PrevVal, TmpAutoDereVal: TFpValue; @@ -2748,7 +2800,7 @@ var end; if not DoExpArray then begin - ResIdx := Res.FList.Add(ACurrentVal); + ResIdx := InternalAdd(ACurrentVal, ACurDepth, ACurKeyIdx, ACurKey); if (ACurrentVal.TypeInfo = nil) or (not ACurrentVal.TypeInfo.IsEqual(TpSym)) then Res.Flags := Res.Flags + [vfArrayOfVariant]; @@ -2762,9 +2814,9 @@ var s := Seen.Add(DA, ResIdx); if DoExpArray then - Result := FlattenArray(ACurrentVal, AnExpandDepth) + Result := FlattenArray(ACurrentVal, ACurDepth + 1, ACurKeyIdx, ACurKey, AnExpandDepth) else - Result := FlattenRecurse(ACurrentVal); + Result := FlattenRecurse(ACurrentVal, ACurDepth+1, ACurKey); ReleaseRefAndNil(ACurrentVal); if (iffShowSeen in Flags) then @@ -2773,7 +2825,8 @@ var Seen.Delete(s); end; - function FlattenArray(ACurrentVal: TFpValue; AnExpandDepth: integer): boolean; + function FlattenArray(ACurrentVal: TFpValue; ACurDepth, ACurKeyIdx: integer; ACurKey: String; + AnExpandDepth: integer): boolean; var Idx: Integer; TmpNew: TFpValue; @@ -2782,19 +2835,20 @@ var if Res.FList.Count >= MaxCnt then exit(False); TmpNew := ACurrentVal.Member[Idx]; - Result := AddFlatValue(TmpNew, Max(0, AnExpandDepth-1)); + Result := AddFlatValue(TmpNew, ACurDepth, ACurKeyIdx, ACurKey+'['+IntToStr(Idx)+']', Max(0, AnExpandDepth-1)); if not Result then exit; end; Result := True; end; - function FlattenRecurse(ACurrentVal: TFpValue): boolean; + function FlattenRecurse(ACurrentVal: TFpValue; ACurDepth: integer; ACurKey: String): boolean; var i: Integer; OrigVal, AutoDereVal, TmpNew: TFpValue; Expr: TFpPascalExpressionPart; r: Boolean; + NxtKey: String; begin Result := True; if HighParam < 2 then @@ -2863,10 +2917,24 @@ var ReleaseRefAndNil(TmpNew); end; - if TmpNew = nil then + if TmpNew = nil then begin + if (iffShowErrAny in Flags) then + AddErrToList(CreateError(fpErrAnyError, ['Internal error for member: ' + FFlattenMemberName + ' '+ErrorHandler.ErrorAsString(FExpression.Error)])); Continue; + end; - r := AddFlatValue(TmpNew, ExpandArrayDepth); + if (iffObj4 in Flags) and (Length(ACurKey) < 1000) then begin + if (ACurKey = '') then + NxtKey := IntToStr(i-2) + else + NxtKey := ACurKey + '.' + IntToStr(i-2); + end + else begin + NxtKey := Expr.GetFullText; + if (iffObj3 in Flags) and (ACurKey <> '') and (Length(ACurKey) < 1000) then + NxtKey := ACurKey + '.' + NxtKey + end; + r := AddFlatValue(TmpNew, ACurDepth, i-2, NxtKey, ExpandArrayDepth); if not r then exit(False); end; @@ -2919,9 +2987,13 @@ begin (TFpPascalExpressionPartOperatorUnaryPlusMinus(LastParam).Count = 1) and (TFpPascalExpressionPartOperatorUnaryPlusMinus(LastParam).Items[0] is TFpPascalExpressionPartBracketSet) then begin + // Add or Sub from defaults LastParamNeg := LastParam.GetText = '-'; LastParam := TFpPascalExpressionPartOperatorUnaryPlusMinus(LastParam).Items[0]; - end; + end + else + if LastParam is TFpPascalExpressionPartBracketSet then + Flags := []; // NO +/- => Start with empty, if LastParam is TFpPascalExpressionPartBracketSet then begin if (FirstVal.Kind <> skArray) and (not CheckArgumentCount(AParams, 3, 999)) then @@ -2932,9 +3004,8 @@ begin SetError('Not enough parameter'); exit; end; - - if not LastParamNeg then - Flags := []; + if (HighParam > 2) and (Flags <> []) then + Flags := Flags + [iffObj1]; for i := 0 to OptSet.Count - 1 do begin Itm := OptSet.Items[i]; @@ -2969,13 +3040,36 @@ begin 'err', 'error': if OVal then include(Flags, iffShowErrAny) else exclude(Flags, iffShowErrAny); 'array': ExpandArrayDepth := 1; 'ptr', 'deref': if OVal then include(Flags, iffDerefPtr) else exclude(Flags, iffDerefPtr); + 'obj': begin + Flags := Flags - [iffObj1, iffObj2, iffObj3, iffObj4]; + if OVal then include(Flags, iffObj1); + end; + 'o1', 'obj1': begin + if Oval then Flags := Flags - [iffObj1, iffObj2, iffObj3, iffObj4]; + if OVal then include(Flags, iffObj1) else exclude(Flags, iffObj1); + end; + 'o2', 'obj2': begin + if Oval then Flags := Flags - [iffObj1, iffObj2, iffObj3, iffObj4]; + if OVal then include(Flags, iffObj2) else exclude(Flags, iffObj2); + end; + 'o3', 'obj3': begin + if Oval then Flags := Flags - [iffObj1, iffObj2, iffObj3, iffObj4]; + if OVal then include(Flags, iffObj3) else exclude(Flags, iffObj3); + end; + 'o4', 'obj4': begin + if Oval then Flags := Flags - [iffObj1, iffObj2, iffObj3, iffObj4]; + if OVal then include(Flags, iffObj4) else exclude(Flags, iffObj4); + end; else begin SetError('Unknown flag: '+Itm.GetText); exit; end; end; end; - end; + end + else + if HighParam > 2 then + Flags := Flags + [iffObj1]; end; ListCache := nil; @@ -3040,16 +3134,16 @@ begin Seen.Add(DA); if (FirstVal.Kind = skArray) then begin - FlattenArray(FirstVal, Max(1, ExpandArrayDepth)); + FlattenArray(FirstVal, 0, -1, '', Max(1, ExpandArrayDepth)); end else begin - Res.FList.Add(FirstVal); + InternalAdd(FirstVal, 0, -1, ''); if not IsReadableLoc(DA) then exit; if IsError(Expression.Error) then exit; - Res.FFullEvaluated := FlattenRecurse(FirstVal); + Res.FFullEvaluated := FlattenRecurse(FirstVal, 0, ''); end; finally Seen.Free; diff --git a/components/fpdebug/fpwatchresultdata.pas b/components/fpdebug/fpwatchresultdata.pas index ad1755e4ff..9bd4ce95e7 100644 --- a/components/fpdebug/fpwatchresultdata.pas +++ b/components/fpdebug/fpwatchresultdata.pas @@ -750,8 +750,8 @@ begin end; sym := MemberValue.DbgSymbol; + MbName := MemberValue.Name; if sym <> nil then begin - MbName := sym.Name; case sym.MemberVisibility of svPrivate: MBVis := dfvPrivate; svProtected: MBVis := dfvProtected; @@ -760,7 +760,6 @@ begin end; end else begin - MbName := ''; MBVis := dfvUnknown; end; diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index 306f94e26f..36a87577fb 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -2037,7 +2037,7 @@ begin weMatch('rec',skNone).ExpectError() ], 5)).IgnTypeName(); - t.Add('flatten', ':flatten(f1, Next, Value, [loop, nil])', weArray([ + t.Add('flatten', ':flatten(f1, Next, Value, [loop, nil, obj=false])', weArray([ weMatch('Value *:?=? ?1', skClass), weMatch('Value *:?=? ?2', skClass), weMatch('Value *:?=? ?3', skClass), @@ -2048,7 +2048,7 @@ begin weInteger(2), weInteger(1) ], 9)).IgnTypeName(); - t.Add('flatten', ':flatten(f1, Next, Value)', weArray([ + t.Add('flatten', ':flatten(f1, Next, Value, -[obj])', weArray([ weMatch('Value *:?=? ?1', skClass), weMatch('Value *:?=? ?2', skClass), weMatch('Value *:?=? ?3', skClass), @@ -2060,7 +2060,7 @@ begin weInteger(1) ], 9)).IgnTypeName(); - t.Add('flatten', ':flatten(f1, Next, Dummy)', weArray([ + t.Add('flatten', ':flatten(f1, Next, Dummy, -[obj, err])', weArray([ weMatch('Value *:?=? ?1', skClass), weMatch('Value *:?=? ?2', skClass), weMatch('Value *:?=? ?3', skClass), @@ -2086,11 +2086,11 @@ begin weInteger(991) ], 3)).IgnTypeName(); - t.Add('flatten', ':flatten(f1.Dummy, (:_.a), [loop])', weArray([ + t.Add('flatten', ':flatten(f1.Dummy, (:_.a), [loop, obj=false])', weArray([ weRecord(weInteger(991).N('a')), weInteger(991) ], 2)).IgnTypeName(); - t.Add('flatten', ':flatten(f1.Dummy, (TDummy(:_.a)), [loop])', weArray([ + t.Add('flatten', ':flatten(f1.Dummy, (TDummy(:_.a)), [loop, obj=false])', weArray([ weRecord(weInteger(991).N('a')), weRecord(weInteger(991).N('a')), // the typecast => diff location weMatch('err',skNone).ExpectError() // rec