From 513236351889dcf146dfcac643c49565e91ff1ac Mon Sep 17 00:00:00 2001 From: Martin Date: Thu, 17 Oct 2024 22:20:56 +0200 Subject: [PATCH] FpDebug: Improve operations on sets. Allow set of char/num. --- components/fpdebug/fpdbginfo.pas | 51 +++- components/fpdebug/fppascalparser.pas | 265 ++++++++++++------ .../lazdebuggerfp/test/testwatches.pas | 59 ++++ 3 files changed, 284 insertions(+), 91 deletions(-) diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 6898d9222f..355b3b9ccd 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -427,27 +427,33 @@ type TFpValueConstEnumValue = class(TFpValueConstWithType) private FEnumName: String; + FEnumVal: QWord; + FHasVal: Boolean; protected function GetFieldFlags: TFpValueFieldFlags; override; function GetKind: TDbgSymbolKind; override; function GetAsString: AnsiString; override; + function GetAsCardinal: QWord; override; + function GetAsInteger: Int64; override; public - constructor Create(AName: String); + constructor Create(AName: String); overload; + constructor Create(AName: String; AVal: QWord); overload; end; { TFpValueConstSet } TFpValueConstSet = class(TFpValueConstWithType) private - FNames: TStrings; + FList: TRefCntObjList; protected function GetFieldFlags: TFpValueFieldFlags; override; function GetKind: TDbgSymbolKind; override; function GetMember(AIndex: Int64): TFpValue; override; function GetMemberCount: Integer; override; public - constructor Create(ANames: TStrings); + constructor Create; destructor Destroy; override; + procedure AddVal(AVal: TFpValue); end; { TFpValueConstStruct } @@ -1579,7 +1585,10 @@ end; function TFpValueConstEnumValue.GetFieldFlags: TFpValueFieldFlags; begin Result := inherited GetFieldFlags; - Result := Result + [{svfOrdinal,} svfIdentifier]; + if FEnumName <> '' then + Result := Result + [svfIdentifier]; + if FHasVal then + Result := Result + [svfOrdinal]; end; function TFpValueConstEnumValue.GetKind: TDbgSymbolKind; @@ -1592,10 +1601,28 @@ begin Result := FEnumName; end; +function TFpValueConstEnumValue.GetAsCardinal: QWord; +begin + Result := FEnumVal; +end; + +function TFpValueConstEnumValue.GetAsInteger: Int64; +begin + Result := int64(FEnumVal); +end; + constructor TFpValueConstEnumValue.Create(AName: String); begin inherited Create; FEnumName := AName; + FHasVal := False; +end; + +constructor TFpValueConstEnumValue.Create(AName: String; AVal: QWord); +begin + FEnumName := AName; + FEnumVal := AVal; + FHasVal := True; end; { TFpValueConstSet } @@ -1613,24 +1640,30 @@ end; function TFpValueConstSet.GetMember(AIndex: Int64): TFpValue; begin - Result := TFpValueConstEnumValue.Create(FNames[AIndex]); + Result := TFpValue(FList[AIndex]); + Result.AddReference; end; function TFpValueConstSet.GetMemberCount: Integer; begin - Result := FNames.Count; + Result := FList.Count; end; -constructor TFpValueConstSet.Create(ANames: TStrings); +constructor TFpValueConstSet.Create; begin + FList := TRefCntObjList.Create; inherited Create; - FNames := ANames; end; destructor TFpValueConstSet.Destroy; begin inherited Destroy; - FNames.Free; + FList.Free; +end; + +procedure TFpValueConstSet.AddVal(AVal: TFpValue); +begin + FList.Add(AVal); end; { TFpValueConstStruct } diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index ae32a79c93..eb7583951d 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -2329,8 +2329,17 @@ end; { TFpPascalExpressionPartBracketSet } function TFpPascalExpressionPartBracketSet.DoGetResultValue: TFpValue; +var + i: Integer; + itm: TFpPascalExpressionPart; + m: TFpValue; begin - Result := TFpValueConstSet.Create(TFpPascalExpressionPartListForwarder.Create(Self, 0, Count)); + Result := TFpValueConstSet.Create; + for i := 0 to Count - 1 do begin + itm := Items[i]; + m := itm.ResultValue; + TFpValueConstSet(Result).AddVal(m); + end; end; function TFpPascalExpressionPartBracketSet.HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; @@ -6307,30 +6316,44 @@ function TFpPascalExpressionPartOperatorPlusMinus.DoGetResultValue: TFpValue; end; function AddSets(ASetVal, AOtherVal: TFpValue): TFpValue; var - r: TStringList; - i: Integer; - m: TFpValue; - s: String; + i, j: Integer; + m, m2: TFpValue; + f: TFpValueFieldFlags; + r: Boolean; begin Result := nil; case AOtherVal.Kind of skSet: begin - r := TStringList.Create; - r.CaseSensitive := False; + Result := TFpValueConstSet.Create; for i := 0 to ASetVal.MemberCount - 1 do begin m := ASetVal.Member[i]; - s := m.AsString; + TFpValueConstSet(Result).AddVal(m); m.ReleaseReference; - r.Add(s); end; + for i := 0 to AOtherVal.MemberCount - 1 do begin m := AOtherVal.Member[i]; - s := m.AsString; + j := ASetVal.MemberCount - 1; + while j >= 0 do begin + m2 := ASetVal.Member[j]; + f := m.FieldFlags * m2.FieldFlags; + if svfOrdinal in f then + r := m.AsCardinal = m2.AsCardinal + else + if svfIdentifier in f then + r := m.AsString = m2.AsString + else + r := False; + m2.ReleaseReference; + if r then + break; + dec(j); + end; + + if j < 0 then + TFpValueConstSet(Result).AddVal(m); m.ReleaseReference; - if r.IndexOf(s) < 0 then - r.Add(s); end; - Result := TFpValueConstSet.Create(r); end; else SetError('Operator +: set union requires a set as 2nd operator'); end; @@ -6374,31 +6397,38 @@ function TFpPascalExpressionPartOperatorPlusMinus.DoGetResultValue: TFpValue; end; function SubtractSets(ASetVal, AOtherVal: TFpValue): TFpValue; var - r: TStringList; i, j: Integer; - m: TFpValue; - s: String; + m, m2: TFpValue; + f: TFpValueFieldFlags; + r: Boolean; begin Result := nil; case AOtherVal.Kind of skSet: begin - r := TStringList.Create; - r.CaseSensitive := False; + Result := TFpValueConstSet.Create; for i := 0 to ASetVal.MemberCount - 1 do begin m := ASetVal.Member[i]; - s := m.AsString; + j := AOtherVal.MemberCount - 1; + while j >= 0 do begin + m2 := AOtherVal.Member[j]; + f := m.FieldFlags * m2.FieldFlags; + if svfOrdinal in f then + r := m.AsCardinal = m2.AsCardinal + else + if svfIdentifier in f then + r := m.AsString = m2.AsString + else + r := False; + m2.ReleaseReference; + if r then + break; + dec(j); + end; + + if j < 0 then + TFpValueConstSet(Result).AddVal(m); m.ReleaseReference; - r.Add(s); end; - for i := 0 to AOtherVal.MemberCount - 1 do begin - m := AOtherVal.Member[i]; - s := m.AsString; - m.ReleaseReference; - j := r.IndexOf(s); - if j >= 0 then - r.Delete(j); - end; - Result := TFpValueConstSet.Create(r); end; else SetError('Operator -: set diff requires a set as 2nd operator'); end; @@ -6497,29 +6527,38 @@ function TFpPascalExpressionPartOperatorMulDiv.DoGetResultValue: TFpValue; end; function MultiplySets(ASetVal, AOtherVal: TFpValue): TFpValue; var - r: TStringList; i, j: Integer; - m: TFpValue; - s, s1, s2: String; + m, m2: TFpValue; + f: TFpValueFieldFlags; + r: Boolean; begin Result := nil; case AOtherVal.Kind of skSet: begin - r := TStringList.Create; + Result := TFpValueConstSet.Create; for i := 0 to ASetVal.MemberCount - 1 do begin m := ASetVal.Member[i]; - s := m.AsString; - s1 := LowerCase(s); - m.ReleaseReference; - for j := 0 to AOtherVal.MemberCount - 1 do begin - m := AOtherVal.Member[j]; - s2 := LowerCase(m.AsString); - m.ReleaseReference; - if s1 = s2 then - r.Add(s); + j := AOtherVal.MemberCount - 1; + while j >= 0 do begin + m2 := AOtherVal.Member[j]; + f := m.FieldFlags * m2.FieldFlags; + if svfOrdinal in f then + r := m.AsCardinal = m2.AsCardinal + else + if svfIdentifier in f then + r := m.AsString = m2.AsString + else + r := False; + m2.ReleaseReference; + if r then + break; + dec(j); end; + + if j >= 0 then + TFpValueConstSet(Result).AddVal(m); + m.ReleaseReference; end; - Result := TFpValueConstSet.Create(r); end; else SetError('Operator *: set intersection requires a set as 2nd operator'); end; @@ -7151,37 +7190,60 @@ function TFpPascalExpressionPartOperatorCompare.DoGetResultValue: TFpValue; function SymDiffSets(ASetVal, AOtherVal: TFpValue): TFpValue; var - r: TStringList; - i, j, c: Integer; - m: TFpValue; - s: String; + i, j: Integer; + m, m2: TFpValue; + f: TFpValueFieldFlags; + r: Boolean; begin - Result := nil; - r := TStringList.Create; - r.CaseSensitive := False; + Result := TFpValueConstSet.Create; + for i := 0 to ASetVal.MemberCount - 1 do begin m := ASetVal.Member[i]; - s := m.AsString; + j := AOtherVal.MemberCount - 1; + while j >= 0 do begin + m2 := AOtherVal.Member[j]; + f := m.FieldFlags * m2.FieldFlags; + if svfOrdinal in f then + r := m.AsCardinal = m2.AsCardinal + else + if svfIdentifier in f then + r := m.AsString = m2.AsString + else + r := False; + m2.ReleaseReference; + if r then + break; + dec(j); + end; + + if j < 0 then + TFpValueConstSet(Result).AddVal(m); m.ReleaseReference; - if r.IndexOf(s) < 0 then - r.Add(s); end; - c := r.Count; + for i := 0 to AOtherVal.MemberCount - 1 do begin m := AOtherVal.Member[i]; - s := m.AsString; - m.ReleaseReference; - j := r.IndexOf(s); - if j < c then begin // otherwise the 2nd set has duplicate idents - if j >= 0 then begin - r.Delete(j); - dec(c) - end + j := ASetVal.MemberCount - 1; + while j >= 0 do begin + m2 := ASetVal.Member[j]; + f := m.FieldFlags * m2.FieldFlags; + if svfOrdinal in f then + r := m.AsCardinal = m2.AsCardinal else - r.Add(s); + if svfIdentifier in f then + r := m.AsString = m2.AsString + else + r := False; + m2.ReleaseReference; + if r then + break; + dec(j); end; + + if j < 0 then + TFpValueConstSet(Result).AddVal(m); + m.ReleaseReference; end; - Result := TFpValueConstSet.Create(r); end; {$POP} var @@ -7398,8 +7460,11 @@ end; function TFpPascalExpressionPartOperatorMemberIn.DoGetResultValue: TFpValue; var AVal, ASet, m: TFpValue; - s, s2: String; + s: String; i: Integer; + f, af: TFpValueFieldFlags; + r: Boolean; + v: QWord; begin Result := nil; if Count <> 2 then begin @@ -7420,31 +7485,67 @@ begin end; - if AVal.Kind <> skEnumValue then begin - SetError('"in" requires an enum'); + if (AVal.Kind in [skEnum, skEnumValue]) then begin + s := ''; + v := 0; + af := AVal.FieldFlags; + if svfIdentifier in af then + s := LowerCase(AVal.AsString); + if svfOrdinal in af then + v := AVal.AsCardinal; + + r := False; + for i := 0 to ASet.MemberCount-1 do begin + m := ASet.Member[i]; + f := m.FieldFlags * af; + if svfIdentifier in f then + r := LowerCase(m.AsString) = s + else + if svfOrdinal in f then + r := m.AsCardinal = v + else + r := False; + m.ReleaseReference; + + if r then + break; + end; + + Result := TFpValueConstBool.Create(r); + {$IFDEF WITH_REFCOUNT_DEBUG} + if Result <> nil then + Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} exit; end; - s := LowerCase(AVal.AsString); - for i := 0 to ASet.MemberCount-1 do begin - m := ASet.Member[i]; - s2 := LowerCase(m.AsString); - m.ReleaseReference; - if s = s2 then begin - Result := TFpValueConstBool.Create(True); - {$IFDEF WITH_REFCOUNT_DEBUG} - if Result <> nil then - Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} - exit; + if (AVal.Kind in [skChar, skSimple, skCardinal, skInteger]) and + (svfOrdinal in AVal.FieldFlags) + then begin + v := AVal.AsCardinal; + r := False; + for i := 0 to ASet.MemberCount-1 do begin + m := ASet.Member[i]; + f := m.FieldFlags; + if svfOrdinal in m.FieldFlags then + r := m.AsCardinal = v + else + r := False; + m.ReleaseReference; + + if r then + break; end; + + Result := TFpValueConstBool.Create(r); + {$IFDEF WITH_REFCOUNT_DEBUG} + if Result <> nil then + Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} + exit; end; - Result := TFpValueConstBool.Create(False); - {$IFDEF WITH_REFCOUNT_DEBUG} - if Result <> nil then - Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF} + SetError('"in" requires an enum'); end; { TFpPasParserValueSlicedArrayIndex } diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index c4ccbbfa02..b538905158 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -4078,6 +4078,7 @@ begin RunToPause(BrkPrg); t.Clear; + // test mem leaks // json content t.Add('json ', '''[1,2]''', weAnsiStr('[1,2]','')).IgnTypeName.IgnKind; t.Add('json ', '''[1,2,}]''', weAnsiStr('[1,2,}]','')).IgnTypeName.IgnKind; @@ -4263,6 +4264,64 @@ begin t.Add('Pointer-Op: ', '@gv_sa_Word[2] - @gv_sa_Word[1]', weInteger(1)); t.Add('Pointer-Op: ', 'pointer(@gv_sa_Word[2]) - pointer(@gv_sa_Word[1])', weInteger(2)); + + t.Add('Set + ', '[]+[]', weSet([])).IgnTypeName; + t.Add('Set + ', '[]+[EnVal4]', weSet(['EnVal4'])).IgnTypeName; + t.Add('Set + ', '[EnVal1]+[]', weSet(['EnVal1'])).IgnTypeName; + t.Add('Set + ', '[EnVal1]+[EnVal4]', weSet(['EnVal1', 'EnVal4'])).IgnTypeName; + t.Add('Set + ', '[EnVal1]+[EnVal2, EnVal4]', weSet(['EnVal1', 'EnVal2', 'EnVal4'])).IgnTypeName; + t.Add('Set + ', '[EnVal1, EnVal3]+[EnVal2, EnVal4]', weSet(['EnVal1', 'EnVal3', 'EnVal2', 'EnVal4'])).IgnTypeName; + + t.Add('Set + ', 'gvSet+gvSet2', weSet(['EnVal2', 'EnVal4', 'EnVal1'])).IgnTypeName.Skip([stDwarf]); + t.Add('Set + ', 'gvSet+[EnVal3]', weSet(['EnVal2', 'EnVal4', 'EnVal3'])).IgnTypeName.Skip([stDwarf]); + t.Add('Set + ', '[EnVal3]+gvSet', weSet(['EnVal3', 'EnVal2', 'EnVal4'])).IgnTypeName.Skip([stDwarf]); + + t.Add('Set + ', '[1,2]+[3,4]', weSet(['1','2','3','4'])).IgnTypeName; + + t.Add('Set - ', '[]-[]', weSet([])).IgnTypeName; + t.Add('Set - ', '[]-[EnVal4]', weSet([])).IgnTypeName; + t.Add('Set - ', '[EnVal1]-[]', weSet(['EnVal1'])).IgnTypeName; + t.Add('Set - ', '[EnVal1]-[EnVal4]', weSet(['EnVal1'])).IgnTypeName; + t.Add('Set - ', '[EnVal1, EnVal4]-[EnVal4]', weSet(['EnVal1'])).IgnTypeName; + + t.Add('Set >< ', '[]><[]', weSet([])).IgnTypeName; + t.Add('Set >< ', '[EnVal4]><[EnVal4]', weSet([])).IgnTypeName; + t.Add('Set >< ', '[]><[EnVal4]', weSet(['EnVal4'])).IgnTypeName; + t.Add('Set >< ', '[EnVal1]><[]', weSet(['EnVal1'])).IgnTypeName; + + + t.Add('IN: ', '1 in [1,2]', weBool(True)).IgnTypeName; + t.Add('IN: ', '1 in [01,2]', weBool(True)).IgnTypeName; + t.Add('IN: ', '1 in [-1,2,1]', weBool(True)).IgnTypeName; + t.Add('IN: ', '-1 in [-1,2,1]', weBool(True)).IgnTypeName; + t.Add('IN: ', '1 in [2,3]', weBool(False)).IgnTypeName; + t.Add('IN: ', '1 in []', weBool(False)).IgnTypeName; + + t.Add('IN: ', 'gvWord in [-1, 101, 2]', weBool(True)).IgnTypeName; + t.Add('IN: ', 'gvWord in [-1, 1010, 2]', weBool(False)).IgnTypeName; + t.Add('IN: ', 'gvWord in []', weBool(False)).IgnTypeName; + + t.Add('IN: ', '101 in [-1, gvWord, 2]', weBool(True)).IgnTypeName; + t.Add('IN: ', '102 in [-1, gvWord+1, 2]', weBool(True)).IgnTypeName; + t.Add('IN: ', '102 in [-1, gvWord, 2]', weBool(False)).IgnTypeName; + t.Add('IN: ', '101 in [-1, gvWord+1, 2]', weBool(False)).IgnTypeName; + + t.Add('IN: ', '''a'' in [''a'', ''b'']', weBool(True)).IgnTypeName; + t.Add('IN: ', '''c'' in [''a'', ''b'']', weBool(False)).IgnTypeName; + t.Add('IN: ', '''c'' in []', weBool(False)).IgnTypeName; + + t.Add('IN: ', 'gvChar3 in [''a'', '' '']', weBool(True)).IgnTypeName; + t.Add('IN: ', 'gvChar3 in [''a'', ''d'']', weBool(False)).IgnTypeName; + t.Add('IN: ', 'gvChar3 in []', weBool(False)).IgnTypeName; + + + t.Add('IN: ', 'EnVal1 in [EnVal1, EnVal2]', weBool(True)).IgnTypeName; + t.Add('IN: ', 'EnVal1 in [EnVal2, EnVal3]', weBool(False)).IgnTypeName; + t.Add('IN: ', 'EnVal1 in []', weBool(False)).IgnTypeName; + + t.Add('IN: ', 'EnVal1 in gvSet2', weBool(True)).IgnTypeName.Skip([stDwarf]); + t.Add('IN: ', 'EnVal3 in gvSet2', weBool(False)).IgnTypeName.Skip([stDwarf]); + AddWatches(t, 'glob', 'gv', 001, 'B', '', tlAny, 'gv', 001, 'B', '', tlAny); AddWatches(t, 'glob', 'gc', 000, 'A', '', tlConst, 'gv', 001, 'B', '', tlAny); AddWatches(t, 'glob', 'gv', 001, 'B', '', tlAny, 'gc', 000, 'A', '', tlConst);