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

IdeDebugger: Introduce a StringBuilder to concatenate all the parts of a watch (speed up for certain nested array/struct values)

Browse Source
This commit is contained in:
Martin 2024-08-26 00:19:42 +02:00
parent 34ec22dc99
commit 0c1d094efc
2 changed files with 889 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

457
ide/packages/idedebugger/idedebuggerwatchresprinter.pas
View File

@ -7,8 +7,8 @@ interface
uses uses
Classes, SysUtils, Math, IdeDebuggerWatchResult, IdeDebuggerUtils, IdeDebuggerDisplayFormats, Classes, SysUtils, Math, IdeDebuggerWatchResult, IdeDebuggerUtils, IdeDebuggerDisplayFormats,
IdeDebuggerBase, IdeDebuggerStringConstants, IdeDebuggerValueFormatter, LazDebuggerIntf, LazUTF8, IdeDebuggerBase, IdeDebuggerStringConstants, IdeDebuggerValueFormatter, IdeDebuggerWatchResUtils,
IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils; LazDebuggerIntf, LazUTF8, IdeDebuggerWatchValueIntf, StrUtils, LazDebuggerUtils;
type type
@ -103,12 +103,12 @@ type
const ANumFormat: TResolvedDisplayFormatNum; const ANumFormat: TResolvedDisplayFormatNum;
PrintNil: Boolean = False PrintNil: Boolean = False
): String; ): String;
function PrintArray(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; function PrintArray(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
function PrintStruct(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; function PrintStruct(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
function PrintConverted(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; function PrintConverted(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
function PrintProc(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String; function PrintProc(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): TStringBuilderPart;
function PrintWatchValueEx(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; function PrintWatchValueEx(AResValue: TWatchResultData; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): TStringBuilderPart;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -601,7 +601,8 @@ begin
end; end;
function TWatchResultPrinter.PrintArray(AResValue: TWatchResultData; function TWatchResultPrinter.PrintArray(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
): TStringBuilderPart;
type type
TIntegerArray = array of integer; TIntegerArray = array of integer;
@ -695,11 +696,11 @@ var
CouldHide, OldCurrentArrayLenShown, LoopCurrentArrayLenShown, CouldSingleLine, CouldHide, OldCurrentArrayLenShown, LoopCurrentArrayLenShown, CouldSingleLine,
ShowMultiLine: Boolean; ShowMultiLine: Boolean;
MultiLine: TWatchDisplayFormatMultiline; MultiLine: TWatchDisplayFormatMultiline;
Results: array of string;
PrefixIdxList: TIntegerArray; PrefixIdxList: TIntegerArray;
LenPrefix: TWatchDisplayFormatArrayLen; LenPrefix: TWatchDisplayFormatArrayLen;
ArrayTypes: TLzDbgArrayTypes; ArrayTypes: TLzDbgArrayTypes;
EntryVal: TWatchResultData; EntryVal: TWatchResultData;
R2: PString;
begin begin
inc(FCurrentMultilineLvl); inc(FCurrentMultilineLvl);
if (ANestLvl > FDeepestArray) then if (ANestLvl > FDeepestArray) then
@ -709,17 +710,18 @@ begin
tn := AResValue.TypeName; tn := AResValue.TypeName;
if (AResValue.Count = 0) and (AResValue.DataAddress = 0) then begin if (AResValue.Count = 0) and (AResValue.DataAddress = 0) then begin
if (ADispFormat.Struct.DataFormat = vdfStructFull) then if (ADispFormat.Struct.DataFormat = vdfStructFull) then
Result := AResValue.TypeName + '(nil)' Result.RawAsStringPtr^ := AResValue.TypeName + '(nil)'
else else
Result := 'nil'; Result.RawAsString := 'nil';
exit; exit;
end; end;
if (ADispFormat.Struct.ShowPointerFormat = vdfStructPointerOnly) then begin if (ADispFormat.Struct.ShowPointerFormat = vdfStructPointerOnly) then begin
Result := '$'+IntToHex(AResValue.DataAddress, HexDigicCount(AResValue.DataAddress, 4, True)); R2 := Result.RawAsStringPtr;
R2^ := '$'+IntToHex(AResValue.DataAddress, HexDigicCount(AResValue.DataAddress, 4, True));
if tn <> '' then if tn <> '' then
Result := tn + '(' + Result + ')'; R2^ := tn + '(' + R2^ + ')';
exit; exit;
end; end;
end; end;
@ -781,16 +783,6 @@ begin
ArrayTypes := [Low(TLzDbgArrayType)..High(TLzDbgArrayType)]; ArrayTypes := [Low(TLzDbgArrayType)..High(TLzDbgArrayType)];
end; end;
Cnt := AResValue.Count;
CutOff := (Cnt < AResValue.ArrayLength);
if CutOff then begin
SetLength(Results, Cnt+1);
end
else
SetLength(Results, Cnt);
if ShowLen then begin if ShowLen then begin
if ShowCombined then begin if ShowCombined then begin
CheckArrayIndexes(AResValue, PrefixIdxList, PrefixIdxCnt, ArrayTypes); CheckArrayIndexes(AResValue, PrefixIdxList, PrefixIdxCnt, ArrayTypes);
@ -813,106 +805,115 @@ begin
LenStr := Format(drsLen2, [LenStr]); LenStr := Format(drsLen2, [LenStr]);
end; end;
end; end;
CouldHide := LenPrefix.HideLen and (AResValue.ArrayLength <= LenPrefix.HideLenThresholdCnt);
if AResValue.ArrayLength = 0 then begin
if ShowLen and not CouldHide then
Result.RawAsStringPtr^ := LenStr + '()'
else
Result.RawAsString := '()';
exit;
end;
Cnt := AResValue.Count;
CutOff := (Cnt < AResValue.ArrayLength);
if CutOff then begin
Result.RawPartCount := Cnt + 1;
end
else
Result.RawPartCount := Cnt;
LoopCurrentArrayLenShown := FCurrentArrayLenShown; LoopCurrentArrayLenShown := FCurrentArrayLenShown;
FCurrentArrayLenShown := False; FCurrentArrayLenShown := False;
CouldHide := LenPrefix.HideLen and (AResValue.ArrayLength <= LenPrefix.HideLenThresholdCnt);
HideLenEach := Max(1, LenPrefix.HideLenThresholdEach); HideLenEach := Max(1, LenPrefix.HideLenThresholdEach);
MaxLen := 1000*1000 div Max(1, ANestLvl*4); MaxLen := 1000*1000 div Max(1, ANestLvl*4);
Len := 0; Len := 0;
if Cnt > 0 then begin if Cnt > 0 then
dec(FElementCount); dec(FElementCount);
for i := 0 to Cnt - 1 do begin for i := 0 to Cnt - 1 do begin
AResValue.SetSelectedIndex(i); AResValue.SetSelectedIndex(i);
ElemCnt := FElementCount; ElemCnt := FElementCount;
EntryVal := AResValue.SelectedEntry; EntryVal := AResValue.SelectedEntry;
Results[i] := PrintWatchValueEx(EntryVal, ADispFormat, ANestLvl, AWatchedExpr); Result.RawParts[i] := PrintWatchValueEx(EntryVal, ADispFormat, ANestLvl, AWatchedExpr);
Len := Len + Length(Results[i]) + SepLen; Len := Len + Result.PartsTotalLen[i] + SepLen;
if CouldHide and ( if CouldHide and (
( (LenPrefix.HideLenThresholdLen > 0) and ( (LenPrefix.HideLenThresholdLen > 0) and
(Length(Results[i]) > LenPrefix.HideLenThresholdLen) (Result.PartsTotalLen[i] > LenPrefix.HideLenThresholdLen)
) or ) or
(FElementCount - ElemCnt > HideLenEach) or (FElementCount - ElemCnt > HideLenEach) or
( (LenPrefix.HideLenThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) ) ( (LenPrefix.HideLenThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
) )
then then
CouldHide := False;
if CouldSingleLine and (
( (MultiLine.ForceSingleLineThresholdLen > 0) and
(Length(Results[i]) > MultiLine.ForceSingleLineThresholdLen)
) or
(FElementCount - ElemCnt > ForceSingleLineEach) or
( (MultiLine.ForceSingleLineThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
)
then
CouldSingleLine := False;
if Len > MaxLen then begin
CutOff := True;
Cnt := i+1;
SetLength(Results, Cnt+1);
end;
end;
if FCurrentArrayLenShown then
CouldHide := False; CouldHide := False;
FCurrentArrayLenShown := FCurrentArrayLenShown or LoopCurrentArrayLenShown;
if FHasLineBreak or if CouldSingleLine and (
( ( (ANestLvl < FDeepestArray) or (MultiLine.ForceSingleLineReverseDepth <= 1) ) and ( (MultiLine.ForceSingleLineThresholdLen > 0) and
(AResValue.FieldCount > MultiLine.ForceSingleLineThresholdStructFld) ) or (Result.PartsTotalLen[i] > MultiLine.ForceSingleLineThresholdLen)
(Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl >= MultiLine.ForceSingleLineReverseDepth) ) or
(FElementCount - ElemCnt > ForceSingleLineEach) or
( (MultiLine.ForceSingleLineThresholdEach = 0) and (EntryVal.ValueKind in [rdkArray, rdkStruct]) )
)
then then
CouldSingleLine := False; CouldSingleLine := False;
if CutOff then begin if Len > MaxLen then begin
Results[Cnt] := '...'; CutOff := True;
inc(Cnt); Cnt := i+1;
Result.RawChangePartCount(Cnt+1);
end; end;
end;
if ShowMultiLine and not CouldSingleLine then begin if FCurrentArrayLenShown then
if (rpfIndent in FFormatFlags) then begin CouldHide := False;
sep := ',' + FLineSeparator + FIndentString; FCurrentArrayLenShown := FCurrentArrayLenShown or LoopCurrentArrayLenShown;
sep2 := FLineSeparator + FIndentString;
end if FHasLineBreak or
else begin ( ( (ANestLvl < FDeepestArray) or (MultiLine.ForceSingleLineReverseDepth <= 1) ) and
sep := ',' + FLineSeparator; (AResValue.FieldCount > MultiLine.ForceSingleLineThresholdStructFld) ) or
sep2 := FLineSeparator; (Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl >= MultiLine.ForceSingleLineReverseDepth)
end; then
if Cnt > 1 then CouldSingleLine := False;
FHasLineBreak := True;
if CutOff then begin
Result.RawPartsAsString[Cnt] := '...';
inc(Cnt);
end;
if ShowMultiLine and not CouldSingleLine then begin
if (rpfIndent in FFormatFlags) then begin
sep := ',' + FLineSeparator + FIndentString;
sep2 := FLineSeparator + FIndentString;
end end
else begin else begin
sep := ', '; sep := ',' + FLineSeparator;
sep2 := ''; sep2 := FLineSeparator;
end; end;
if Result.RawPartCount > 1 then
if (Cnt > 1) and (not CouldSingleLine) then FHasLineBreak := True;
Results[Cnt-1] := Results[Cnt-1] + sep2 +')'
else
Results[Cnt-1] := Results[Cnt-1] +')';
if CouldHide and
(ANestLvl - FCurrentOuterMostArrayLvl >= LenPrefix.HideLenKeepDepth)
then
ShowLen := False;
if ShowLen then begin
Results[0] := LenStr + sep2 + '(' + Results[0];
FCurrentArrayLenShown := True;
end
else
Results[0] := '(' + Results[0];
Result := AnsiString.Join(sep, Results);
end end
else begin else begin
if ShowLen then sep := ', ';
Result := LenStr + '()' sep2 := '';
else
Result := '()';
end; end;
Result.RawSeparator := sep;
//if (Cnt > 1) and (not CouldSingleLine) then
if FHasLineBreak and (not CouldSingleLine) then
Result.RawPostfix := sep2 +')'
else
Result.RawPostfix := ')';
if CouldHide and
(ANestLvl - FCurrentOuterMostArrayLvl >= LenPrefix.HideLenKeepDepth)
then
ShowLen := False;
if ShowLen then begin
Result.RawPrefix := LenStr + sep2 + '(';
FCurrentArrayLenShown := True;
end
else
Result.RawPrefix := '(';
if OldHasLineBreak then if OldHasLineBreak then
FHasLineBreak := True; FHasLineBreak := True;
@ -927,7 +928,8 @@ begin
end; end;
function TWatchResultPrinter.PrintStruct(AResValue: TWatchResultData; function TWatchResultPrinter.PrintStruct(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
): TStringBuilderPart;
const const
VisibilityNames: array [TLzDbgFieldVisibility] of string = ( VisibilityNames: array [TLzDbgFieldVisibility] of string = (
'', 'private', 'protected', 'public', 'published' '', 'private', 'protected', 'public', 'published'
@ -939,48 +941,51 @@ var
vis, sep, tn, Header, we, CurIndentString: String; vis, sep, tn, Header, we, CurIndentString: String;
InclVisSect, OldHasLineBreak, CouldSingleLine, ShowMultiLine: Boolean; InclVisSect, OldHasLineBreak, CouldSingleLine, ShowMultiLine: Boolean;
MultiLine: TWatchDisplayFormatMultiline; MultiLine: TWatchDisplayFormatMultiline;
Results: array of string;
FldIdx, Len, ForceSingleLineEach, ElemCnt, SepLen: Integer; FldIdx, Len, ForceSingleLineEach, ElemCnt, SepLen: Integer;
RR: TStringBuilderPart;
begin begin
inc(FCurrentMultilineLvl); inc(FCurrentMultilineLvl);
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue); Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
Result := '';
tn := AResValue.TypeName; tn := AResValue.TypeName;
Header := '';
if (AResValue.StructType in [dstClass, dstInterface]) if (AResValue.StructType in [dstClass, dstInterface])
then begin then begin
if (AResValue.DataAddress = 0) then begin if (AResValue.DataAddress = 0) then begin
//Result := PrintNumber(0, 0, FTargetAddressSize, Resolved.Num2); //Header := PrintNumber(0, 0, FTargetAddressSize, Resolved.Num2);
Result := 'nil';
if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then
Result := tn + '(' + Result + ')'; Result.RawAsStringPtr^ := tn + '(nil)'
else
Result.RawAsString := 'nil';
exit; exit;
end; end;
if (Resolved.Struct.ShowPointerFormat <> vdfStructPointerOff) or (AResValue.FieldCount = 0) if (Resolved.Struct.ShowPointerFormat <> vdfStructPointerOff) or (AResValue.FieldCount = 0)
then begin then begin
// TODO: for 32 bit target, sign extend the 2nd argument // TODO: for 32 bit target, sign extend the 2nd argument
Result := PrintNumber(AResValue.DataAddress, Int64(AResValue.DataAddress), FTargetAddressSize, Resolved.Num2, True); Header := PrintNumber(AResValue.DataAddress, Int64(AResValue.DataAddress), FTargetAddressSize, Resolved.Num2, True);
if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then begin if (Resolved.Address.TypeFormat = vdfAddressTyped) and (tn <> '') then begin
Result := tn + '(' + Result + ')'; Header := tn + '(' + Header + ')';
tn := ''; tn := '';
end; end;
if (Resolved.Struct.ShowPointerFormat = vdfStructPointerOnly) or (AResValue.FieldCount = 0) then if (Resolved.Struct.ShowPointerFormat = vdfStructPointerOnly) or (AResValue.FieldCount = 0) then begin
Result.RawAsString := Header;
exit; exit;
end; end;
end;
Header := Result;
Result := '';
if Header <> '' then if Header <> '' then
Header := Header + ': '; Header := Header + ': ';
if (Resolved.Struct.DataFormat <> vdfStructFull) and end;
not(AResValue.StructType in [dstClass, dstInterface]) end
else
if (Resolved.Struct.DataFormat <> vdfStructFull)
//and not(AResValue.StructType in [dstClass, dstInterface])
then then
tn := ''; tn := '';
if AResValue.FieldCount = 0 then begin if AResValue.FieldCount = 0 then begin
Result := Header + tn + '()'; Result.RawAsStringPtr^ := Header + tn + '()';
exit; exit;
end; end;
@ -1016,16 +1021,12 @@ begin
inc(FldIdx); inc(FldIdx);
if InclVisSect then if InclVisSect then
inc(FldIdx); inc(FldIdx);
SetLength(Results, AResValue.FieldCount * FldIdx+1); Result.RawPartCount := AResValue.FieldCount * FldIdx;
FldIdx := 0; FldIdx := 0;
if (Header <> '') or (tn <> '') then begin
Results[FldIdx] := Header + tn + '(';
inc(FldIdx);
end;
Len := 0; Len := 0;
for FldInfo in AResValue do begin for FldInfo in AResValue do begin
if Len > 1 + 1000*1000 div Max(1, ANestLvl*4) then begin if Len > 1 + 1000*1000 div Max(1, ANestLvl*4) then begin
Results[FldIdx] := '...'; Result.RawPartsAsString[FldIdx] := '...';
inc(FldIdx); inc(FldIdx);
break; break;
end; end;
@ -1037,8 +1038,8 @@ begin
if (Resolved.Struct.DataFormat = vdfStructFull) and (FldOwner <> nil) and (FldOwner.DirectFieldCount > 0) and if (Resolved.Struct.DataFormat = vdfStructFull) and (FldOwner <> nil) and (FldOwner.DirectFieldCount > 0) and
(AResValue.StructType in [dstClass, dstInterface, dstObject]) // record has no inheritance (AResValue.StructType in [dstClass, dstInterface, dstObject]) // record has no inheritance
then begin then begin
Results[FldIdx] := '{' + FldOwner.TypeName + '}'; Result.RawPartsAsString[FldIdx] := '{' + FldOwner.TypeName + '}';
Len := Len + Length(Results[FldIdx]) + SepLen; Len := Len + Result.PartsTotalLen[FldIdx] + SepLen;
inc(FldIdx); inc(FldIdx);
inc(FElementCount); inc(FElementCount);
end; end;
@ -1046,21 +1047,31 @@ begin
if InclVisSect and (vis <> VisibilityNames[FldInfo.FieldVisibility]) then begin if InclVisSect and (vis <> VisibilityNames[FldInfo.FieldVisibility]) then begin
vis := VisibilityNames[FldInfo.FieldVisibility]; vis := VisibilityNames[FldInfo.FieldVisibility];
Results[FldIdx] := vis; Result.RawPartsAsString[FldIdx] := vis;
Len := Len + Length(Results[FldIdx]) + SepLen; Len := Len + Result.PartsTotalLen[FldIdx] + SepLen;
inc(FldIdx); inc(FldIdx);
inc(FElementCount); inc(FElementCount);
end; end;
ElemCnt := FElementCount; ElemCnt := FElementCount;
Results[FldIdx] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName)) + ';';
if Resolved.Struct.DataFormat <> vdfStructValOnly then if Resolved.Struct.DataFormat <> vdfStructValOnly then begin
Results[FldIdx] := FldInfo.FieldName + ': ' + Results[FldIdx]; RR.RawPartCount := 2;
Len := Len + Length(Results[FldIdx]) + SepLen; RR.RawPartsAsString[0] := FldInfo.FieldName;
RR.RawSeparator := ': ';
RR.RawParts[1] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName));
end
else begin
RR.RawPartCount := 1;
RR.RawParts[0] := PrintWatchValueEx(FldInfo.Field, ADispFormat, ANestLvl, we + UpperCase(FldInfo.FieldName));
end;
RR.RawPostfix := '; ';
Result.RawParts[FldIdx] := RR;
Len := Len + RR.TotalLen + SepLen;
if CouldSingleLine and ( if CouldSingleLine and (
( (MultiLine.ForceSingleLineThresholdLen > 0) and ( (MultiLine.ForceSingleLineThresholdLen > 0) and
(Length(Results[FldIdx]) > MultiLine.ForceSingleLineThresholdLen) (Result.PartsTotalLen[FldIdx] > MultiLine.ForceSingleLineThresholdLen)
) or ) or
(FElementCount - ElemCnt > ForceSingleLineEach) or (FElementCount - ElemCnt > ForceSingleLineEach) or
( (MultiLine.ForceSingleLineThresholdEach = 0) and (FldInfo.Field.ValueKind in [rdkArray, rdkStruct]) ) ( (MultiLine.ForceSingleLineThresholdEach = 0) and (FldInfo.Field.ValueKind in [rdkArray, rdkStruct]) )
@ -1071,7 +1082,7 @@ begin
inc(FldIdx); inc(FldIdx);
end; end;
SetLength(Results, FldIdx); Result.RawChangePartCount(FldIdx);
if FHasLineBreak or if FHasLineBreak or
(Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl > MultiLine.ForceSingleLineReverseDepth) (Min(FDeepestMultilineLvl, MultiLine.MaxMultiLineDepth) - FCurrentMultilineLvl > MultiLine.ForceSingleLineReverseDepth)
then then
@ -1085,29 +1096,33 @@ begin
end end
else else
sep := ' '; sep := ' ';
Result.RawSeparator := sep;
dec(FldIdx);
if FHasLineBreak then if FHasLineBreak then
Results[FldIdx] := Results[FldIdx] + sep + ')' Result.RawPostfix := sep + ')'
else else
Results[FldIdx] := Results[FldIdx] + ')'; Result.RawPostfix := ')';
if not ((Header <> '') or (tn <> '')) then if (Header <> '') or (tn <> '') then begin
Results[0] := '(' + Results[0]; Result.RawPrefix := Header + tn + '(' + Sep;
FHasLineBreak := sep <> ' ';
end
else
Result.RawPrefix := '(';
Result := AnsiString.Join(sep, Results); if ((Result.RawPartCount > 1) and (Sep <> ' ')) or OldHasLineBreak then
if ((FldIdx > 0) and (Sep <> ' ')) or OldHasLineBreak then
FHasLineBreak := True; FHasLineBreak := True;
FIndentString := CurIndentString; FIndentString := CurIndentString;
end; end;
function TWatchResultPrinter.PrintConverted(AResValue: TWatchResultData; function TWatchResultPrinter.PrintConverted(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
): TStringBuilderPart;
begin begin
if AResValue.FieldCount = 0 then if AResValue.FieldCount = 0 then begin
exit('Error: No result'); Result.RawAsString := 'Error: No result';
exit;
end;
if (AResValue.FieldCount = 1) or if (AResValue.FieldCount = 1) or
( (AResValue.Fields[0].Field <> nil) and ( (AResValue.Fields[0].Field <> nil) and
@ -1119,31 +1134,35 @@ begin
end; end;
if (AResValue.FieldCount > 1) then begin if (AResValue.FieldCount > 1) then begin
Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
if (AResValue.Fields[0].Field = nil) or if (AResValue.Fields[0].Field = nil) or
(AResValue.Fields[0].Field.ValueKind <> rdkError) or (AResValue.Fields[0].Field.ValueKind <> rdkError) or
(AResValue.Fields[0].Field.AsString <> '') (AResValue.Fields[0].Field.AsString <> '')
then then begin
Result := Result + ' { ' Result.RawPartCount := 4;
+ PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl, AWatchedExpr) Result.RawParts[0] := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
+ ' }'; Result.RawPartsAsString[1] := ' { ';
Result.RawParts[2] := PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl, AWatchedExpr);
Result.RawPartsAsString[3] := ' }';
end
else
Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl, AWatchedExpr);
exit; exit;
end; end;
Result := 'Error: No result'; Result.RawAsString := 'Error: No result';
end; end;
function TWatchResultPrinter.PrintProc(AResValue: TWatchResultData; function TWatchResultPrinter.PrintProc(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): TStringBuilderPart;
var var
Resolved: TResolvedDisplayFormat; Resolved: TResolvedDisplayFormat;
s: String; s, R: String;
begin begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue); Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, TargetAddressSize, Resolved.Num2, True); R := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, TargetAddressSize, Resolved.Num2, True);
if AResValue.AsString <> '' then if AResValue.AsString <> '' then
Result := Result + ' = ' + AResValue.AsString; R := R + ' = ' + AResValue.AsString;
if ANestLvl > 0 then begin if ANestLvl > 0 then begin
s := AResValue.TypeName; s := AResValue.TypeName;
@ -1156,13 +1175,15 @@ begin
if s <> '' then if s <> '' then
if AResValue.ValueKind in [rdkFunctionRef, rdkProcedureRef] then if AResValue.ValueKind in [rdkFunctionRef, rdkProcedureRef] then
Result := Result + ': '+s R := R + ': '+s
else else
Result := s + ' AT ' +Result; R := s + ' AT ' +R;
Result.RawAsString := R;
end; end;
function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData; function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String): String; const ADispFormat: TWatchDisplayFormat; ANestLvl: Integer; const AWatchedExpr: String
): TStringBuilderPart;
function PrintChar: String; function PrintChar: String;
var var
@ -1260,11 +1281,12 @@ function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData;
var var
PointerValue: TWatchResultDataPointer absolute AResValue; PointerValue: TWatchResultDataPointer absolute AResValue;
ResTypeName: String; ResTypeName, R: String;
PtrDeref, PtrDeref2, OldCurrentResValue, OldParentResValue: TWatchResultData; PtrDeref, PtrDeref2, OldCurrentResValue, OldParentResValue: TWatchResultData;
Resolved: TResolvedDisplayFormat; Resolved: TResolvedDisplayFormat;
n, OldCurrentMultilineLvl: Integer; n, OldCurrentMultilineLvl: Integer;
StoredSettings: TWatchResStoredSettings; StoredSettings: TWatchResStoredSettings;
R2: PString;
begin begin
inc(ANestLvl); inc(ANestLvl);
OldCurrentResValue := FCurrentResValue; OldCurrentResValue := FCurrentResValue;
@ -1274,10 +1296,14 @@ begin
FCurrentResValue := AResValue; FCurrentResValue := AResValue;
inc(FElementCount); inc(FElementCount);
try try
if ANestLvl > MAX_ALLOWED_NEST_LVL then if ANestLvl > MAX_ALLOWED_NEST_LVL then begin
exit('...'); Result.RawAsString := '...';
if AResValue = nil then exit;
exit('???'); end;
if AResValue = nil then begin
Result.RawAsString := '???';
exit;
end;
if FCurrentValueFormatter <> nil then begin if FCurrentValueFormatter <> nil then begin
StoreSetting(StoredSettings); StoreSetting(StoredSettings);
@ -1288,8 +1314,10 @@ begin
FWatchedExprInFormatter := AWatchedExpr; FWatchedExprInFormatter := AWatchedExpr;
// //
try try
if FCurrentValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, Result, FWatchedVarName, AWatchedExpr) then R2 := Result.RawAsStringPtr;
if FCurrentValueFormatter.FormatValue(AResValue, ADispFormat, ANestLvl, Self, R2^, FWatchedVarName, AWatchedExpr) then begin
exit; exit;
end;
finally finally
FNextCallIsValueFormatter := False; FNextCallIsValueFormatter := False;
RestoreSetting(StoredSettings); RestoreSetting(StoredSettings);
@ -1298,33 +1326,36 @@ begin
else else
FCurrentValueFormatter := FNextValueFormatter; FCurrentValueFormatter := FNextValueFormatter;
Result := ''; Result.Init;
case AResValue.ValueKind of case AResValue.ValueKind of
rdkError: rdkError:
begin begin
Result := 'Error: ' + AResValue.AsString;
if rpfClearMultiLine in FFormatFlags then if rpfClearMultiLine in FFormatFlags then
Result := ClearMultiline(Result); Result.RawAsStringPtr^ := 'Error: ' + ClearMultiline(AResValue.AsString)
else
Result.RawAsStringPtr^ := 'Error: ' + AResValue.AsString;
end; end;
rdkUnknown: rdkUnknown:
Result := 'Error: Unknown'; Result.RawAsStringPtr^ := 'Error: Unknown';
rdkPrePrinted: begin rdkPrePrinted: begin
Result := AResValue.AsString;
if rpfClearMultiLine in FFormatFlags then if rpfClearMultiLine in FFormatFlags then
Result := ClearMultiline(Result); Result.RawAsStringPtr^ := AResValue.AsString
else
Result.RawAsStringPtr^ := ClearMultiline(AResValue.AsString);
end; end;
rdkSignedNumVal, rdkSignedNumVal,
rdkUnsignedNumVal: begin rdkUnsignedNumVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue); Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num1); R2 := Result.RawAsStringPtr;
R2^ := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num1);
if Resolved.Num2.Visible then begin if Resolved.Num2.Visible then begin
Result := Result +' = ' + R2^ := R2^ +' = ' +
PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num2); PrintNumber(AResValue.AsQWord, AResValue.AsInt64, AResValue.ByteSize, Resolved.Num2);
end; end;
end; end;
rdkPointerVal: begin rdkPointerVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue); Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
Result := ''; R := '';
PtrDeref := PointerValue.DerefData; PtrDeref := PointerValue.DerefData;
if (Resolved.Pointer.DerefFormat = vdfPointerDerefOnly) then if (Resolved.Pointer.DerefFormat = vdfPointerDerefOnly) then
@ -1332,7 +1363,7 @@ begin
if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOnly) or (PtrDeref = nil) then begin if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOnly) or (PtrDeref = nil) then begin
n := AResValue.ByteSize; n := AResValue.ByteSize;
if n = 0 then n := FTargetAddressSize; if n = 0 then n := FTargetAddressSize;
Result := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, n, Resolved.Num2, True); R := PrintNumber(AResValue.AsQWord, AResValue.AsInt64, n, Resolved.Num2, True);
if Resolved.Pointer.Address.TypeFormat = vdfAddressTyped then begin if Resolved.Pointer.Address.TypeFormat = vdfAddressTyped then begin
ResTypeName := AResValue.TypeName; ResTypeName := AResValue.TypeName;
if (ResTypeName = '') and (PtrDeref <> nil) then begin if (ResTypeName = '') and (PtrDeref <> nil) then begin
@ -1341,50 +1372,63 @@ begin
ResTypeName := '^'+ResTypeName; ResTypeName := '^'+ResTypeName;
end; end;
if ResTypeName <> '' then if ResTypeName <> '' then
Result := ResTypeName + '(' + Result + ')'; R := ResTypeName + '(' + R + ')';
end; end;
end; end;
if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOff) and (PtrDeref <> nil) then begin if (Resolved.Pointer.DerefFormat <> vdfPointerDerefOff) and (PtrDeref <> nil) then begin
while (PtrDeref.ValueKind = rdkPointerVal) and (PtrDeref.DerefData <> nil) do begin while (PtrDeref.ValueKind = rdkPointerVal) and (PtrDeref.DerefData <> nil) do begin
PtrDeref2 := PtrDeref; PtrDeref2 := PtrDeref;
Result := Result + '^'; R := R + '^';
PtrDeref := PtrDeref.DerefData; PtrDeref := PtrDeref.DerefData;
end; end;
if PtrDeref <> nil then Result.RawPartCount := 2;
Result := Result + '^: ' + PrintWatchValueEx(PtrDeref, ADispFormat, ANestLvl, AWatchedExpr+'^') if PtrDeref <> nil then begin
else R := R + '^: ';
Result := Result + ': ' + PrintWatchValueEx(PtrDeref2, ADispFormat, ANestLvl, AWatchedExpr+'^'); Result.RawParts[1] := PrintWatchValueEx(PtrDeref, ADispFormat, ANestLvl, AWatchedExpr+'^');
end; end
else begin
R := R + ': ';
Result.RawParts[1] := PrintWatchValueEx(PtrDeref2, ADispFormat, ANestLvl, AWatchedExpr+'^');
end;
Result.RawPartsAsString[0] := R;
end
else
Result.RawAsString := R;
end; end;
rdkFloatVal: begin rdkFloatVal: begin
Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue); Resolved := DisplayFormatResolver.ResolveDispFormat(ADispFormat, AResValue);
if Resolved.Float.NumFormat = vdfFloatScientific then if Resolved.Float.NumFormat = vdfFloatScientific then
case AResValue.FloatPrecission of case AResValue.FloatPrecission of
dfpSingle: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 9, 0); dfpSingle: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 9, 0);
dfpDouble: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 17, 0); dfpDouble: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 17, 0);
dfpExtended: Result := FloatToStrF(AResValue.AsFloat, ffExponent, 21, 0); dfpExtended: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffExponent, 21, 0);
end end
else else
case AResValue.FloatPrecission of case AResValue.FloatPrecission of
dfpSingle: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 9, 0); dfpSingle: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 9, 0);
dfpDouble: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 17, 0); dfpDouble: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 17, 0);
dfpExtended: Result := FloatToStrF(AResValue.AsFloat, ffGeneral, 21, 0); dfpExtended: Result.RawAsStringPtr^ := FloatToStrF(AResValue.AsFloat, ffGeneral, 21, 0);
end; end;
end; end;
rdkChar: Result := PrintChar; rdkChar: Result.RawAsStringPtr^ := PrintChar;
rdkString: Result := QuoteText(AResValue.AsString); rdkString: Result.RawAsStringPtr^ := QuoteText(AResValue.AsString);
rdkWideString: Result := QuoteWideText(AResValue.AsWideString); rdkWideString: Result.RawAsStringPtr^ := QuoteWideText(AResValue.AsWideString);
rdkBool: Result := PrintBool; rdkBool: Result.RawAsStringPtr^ := PrintBool;
rdkEnum, rdkEnumVal: rdkEnum, rdkEnumVal:
Result := PrintEnum; Result.RawAsStringPtr^ := PrintEnum;
rdkSet: Result := PrintSet; rdkSet: Result.RawAsStringPtr^ := PrintSet;
rdkPCharOrString: begin rdkPCharOrString: begin
Result.RawPartCount := 4;
AResValue.SetSelectedIndex(0); // pchar res AResValue.SetSelectedIndex(0); // pchar res
Result := 'PChar: ' + PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr); Result.RawPartsAsString[0] := 'PChar: ';
Result.RawParts[1] := PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
AResValue.SetSelectedIndex(1); // string res AResValue.SetSelectedIndex(1); // string res
Result := Result + FLineSeparator if rpfClearMultiLine in FFormatFlags then
+ 'String: ' + PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr); Result.RawPartsAsString[2] := ' - String: '
else
Result.RawPartsAsString[2] := FLineSeparator + 'String: ';
Result.RawParts[3] := PrintWatchValueEx(AResValue.SelectedEntry, ADispFormat, ANestLvl, AWatchedExpr);
end; end;
rdkArray: Result := PrintArray(AResValue, ADispFormat, ANestLvl, AWatchedExpr); rdkArray: Result := PrintArray(AResValue, ADispFormat, ANestLvl, AWatchedExpr);
rdkStruct: Result := PrintStruct(AResValue, ADispFormat, ANestLvl, AWatchedExpr); rdkStruct: Result := PrintStruct(AResValue, ADispFormat, ANestLvl, AWatchedExpr);
@ -1419,6 +1463,8 @@ end;
function TWatchResultPrinter.PrintWatchValue(AResValue: TWatchResultData; function TWatchResultPrinter.PrintWatchValue(AResValue: TWatchResultData;
const ADispFormat: TWatchDisplayFormat; const AWatchedExpr: String): String; const ADispFormat: TWatchDisplayFormat; const AWatchedExpr: String): String;
var
Res: TStringBuilderPart;
begin begin
FNextValueFormatter := nil; FNextValueFormatter := nil;
if FOnlyValueFormatter <> nil then if FOnlyValueFormatter <> nil then
@ -1443,7 +1489,9 @@ begin
FCurrentMultilineLvl := 0; FCurrentMultilineLvl := 0;
FDeepestMultilineLvl := 0; FDeepestMultilineLvl := 0;
FDeepestArray := 0; FDeepestArray := 0;
Result := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName); Res := PrintWatchValueEx(AResValue, ADispFormat, -1, FWatchedVarName);
Result := Res.GetFullString;
Res.FreeAll;
end; end;
function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf; function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf;
@ -1451,6 +1499,7 @@ function TWatchResultPrinter.PrintWatchValueIntf(AResValue: IWatchResultDataIntf
var var
AResValObj: TWatchResultData; AResValObj: TWatchResultData;
IncLvl: Integer; IncLvl: Integer;
Res: TStringBuilderPart;
begin begin
AResValObj := TWatchResultData(AResValue.GetInternalObject); AResValObj := TWatchResultData(AResValue.GetInternalObject);
FNextValueFormatter := nil; FNextValueFormatter := nil;
@ -1470,7 +1519,9 @@ begin
if FNextCallIsValueFormatter then begin if FNextCallIsValueFormatter then begin
FNextCallIsValueFormatter := False; FNextCallIsValueFormatter := False;
Result := PrintWatchValueEx(AResValObj, ADispFormat, FInValFormNestLevel - 1 + IncLvl, FWatchedExprInFormatter); // This will increase it by one, compared to the value given to the formatter Res := PrintWatchValueEx(AResValObj, ADispFormat, FInValFormNestLevel - 1 + IncLvl, FWatchedExprInFormatter); // This will increase it by one, compared to the value given to the formatter
Result := Res.GetFullString;
Res.FreeAll;
end end
else begin else begin
// TOOD: full init? Or Call PrintWatchValueEx ? // TOOD: full init? Or Call PrintWatchValueEx ?
@ -1481,7 +1532,9 @@ begin
FCurrentMultilineLvl := 0; FCurrentMultilineLvl := 0;
FDeepestMultilineLvl := 0; FDeepestMultilineLvl := 0;
FDeepestArray := 0; FDeepestArray := 0;
Result := PrintWatchValueEx(AResValObj, ADispFormat, -1, FWatchedExprInFormatter); Res := PrintWatchValueEx(AResValObj, ADispFormat, -1, FWatchedExprInFormatter);
Result := Res.GetFullString;
Res.FreeAll;
end; end;
end; end;

634
ide/packages/idedebugger/idedebuggerwatchresutils.pas
View File

@ -1,6 +1,8 @@
unit IdeDebuggerWatchResUtils; unit IdeDebuggerWatchResUtils;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$IFDEF INLINE_OFF}{ $INLINE OFF}{$ENDIF}
{$ModeSwitch advancedrecords}
interface interface
@ -8,6 +10,140 @@ uses
Classes, SysUtils, IdeDebuggerWatchResult, LazDebuggerIntf, Classes, SysUtils, IdeDebuggerWatchResult, LazDebuggerIntf,
IdeDebuggerWatchValueIntf; IdeDebuggerWatchValueIntf;
type
PStringBuilderPart = ^TStringBuilderPart;
{ TStringBuilderPart }
TStringBuilderPart = record// object
private type
PHeader = ^THeader;
THeader = record
FTotalLen, FCount: Integer;
FPrefix, FPostfix, FSeparator: String;
end;
private const
HD_SIZE = sizeof(THeader);
private
FData: Pointer;
FType: (sbfString, sbfStringList, sbfPartList);
function GetAsString: String; inline;
function GetStringCount: Integer; inline;
function GetStrings(AnIndex: Integer): String; inline;
function GetPartCount: Integer; inline;
function GetParts(AnIndex: Integer): TStringBuilderPart; inline;
function GetPartsAsString(AnIndex: Integer): String; inline;
function GetPartsTotalLen(AnIndex: Integer): Integer; inline;
function GetPostfix: String; inline;
function GetPrefix: String; inline;
function GetSeparator: String; inline;
function GetRawPartsPtr(AnIndex: Integer): PStringBuilderPart; inline;
function GetTotalLen: integer; inline;
procedure SetAsString(const AValue: String); inline;
procedure SetStringCount(AValue: Integer); inline;
procedure SetStrings(AnIndex: Integer; const AValue: String); inline;
procedure SetPartCount(AValue: Integer); inline;
procedure SetParts(AnIndex: Integer; AValue: TStringBuilderPart); inline;
procedure SetPartsAsString(AnIndex: Integer; const AValue: String); inline;
procedure SetPostfix(const AValue: String); inline;
procedure SetPrefix(const AValue: String); inline;
procedure SetSeparator(const AValue: String); inline;
procedure SetRawAsString(const AValue: String); inline;
procedure SetRawStringCount(AValue: Integer); inline;
procedure SetRawStrings(AnIndex: Integer; const AValue: String); inline;
procedure SetRawPartCount(AValue: Integer); inline;
procedure SetRawParts(AnIndex: Integer; const AValue: TStringBuilderPart); inline;
procedure SetRawPartsAsString(AnIndex: Integer; const AValue: String);
procedure SetRawPostfix(const AValue: String); inline;
procedure SetRawPrefix(const AValue: String); inline;
procedure SetRawSeparator(const AValue: String); inline;
procedure DoFreeAll;
procedure WriteTo(var ADest: PChar);
public
procedure Init; inline; // Similar to "RawAsString := ''"
procedure FreeAll; inline;
function GetFullString: String;
property TotalLen: integer read GetTotalLen;
public
(* * Init: New TStringBuilderPart must be initialized with "Init"
* Strings[], Parts[], PartsAsString:
- Must only be accessed when the builder has been set to the matching
list type using StringCount or PartCount (index must be in range / no checks)
* Parts[]:
- Must not be changed inline.
- They must be assigned a new TStringBuilderPart that has its final value
- Once assigned changes can be made using PartAsString, AppendToPart, PrependToPart
* Prefix, PostFix, Separator:
- Must only be accessed when the builder is a list
*)
(* *** Single String sbfString *** *)
property AsString: String read GetAsString write SetAsString;
(* *** List of String sbfStringList *** *)
property StringCount: Integer read GetStringCount write SetStringCount;
procedure ChangeStringCount(ANewCount: Integer; ATrim: Boolean = False);
property Strings[AnIndex: Integer]: String read GetStrings write SetStrings;
(* *** List of embedded Parts (sub-builders) sbfPartList *** *)
property PartCount: Integer read GetPartCount write SetPartCount;
procedure ChangePartCount(ANewCount: Integer; ATrim: Boolean = False);
property Parts[AnIndex: Integer]: TStringBuilderPart read GetParts write SetParts;
// Set the "AsString" of a part that is already in the list
property PartsAsString[AnIndex: Integer]: String read GetPartsAsString write SetPartsAsString;
property PartsTotalLen[AnIndex: Integer]: Integer read GetPartsTotalLen;
// Append/Prepend to a part (either to the string, or Pre/FPostFix
procedure PrependToPart(AnIndex: Integer; const AValue: String);
procedure AppendToPart(AnIndex: Integer; const AValue: String);
(* *** List ... *** *)
property Prefix: String read GetPrefix write SetPrefix;
property Postfix: String read GetPostfix write SetPostfix;
property Separator: String read GetSeparator write SetSeparator;
public
(* *** RAW ACCESS ***
* All data must be user initialized
- The following methods will initialize data. (They are "write once". They must not be used to modify data):
Init, RawAsString, RawPartCount, RawStringCount, RawPartsAsString
* Once data/type (string, string-list, part-list) has been set/chosen, it must not be changed anymore
* RawParts:
- Each Part in "RawParts" must be either
- assigned once (with a part that has its data already)
- set with "PartAsString"
- Once a sub-part has been added, it must not be replaced
- Once a sub-part has been added, it must not be modified anymore
(except with Prepend/AppendToPart)
- Once a sub-part has been added, it is owned and must not be freed by itself
- Once a value has been set (subvalue, post/Rawprefix, ...), it must not be changed
- Change...Count is only to cut off uninitialized entries. (data will not be freed, if it had been assigned)
- Before "FreeAll": All strings/Rawparts must have been initialized (use RawChangeCount to cut off uninitialized entries)
*** Ptr / Pointer to String ***
* Using the builders string variable (via pointer) allows the compiler to reduce temporary string vars
*)
(* *** Single String sbfString *** *)
property RawAsString: String read GetAsString write SetRawAsString;
function RawAsStringPtr: PString;
(* *** List of String sbfStringList *** *)
property RawStringCount: Integer read GetStringCount write SetRawStringCount;
procedure RawChangeStringCount(ANewCount: Integer);
property RawStrings[AnIndex: Integer]: String read GetStrings write SetRawStrings;
(* *** List of embedded RawParts (sub-builders) sbfPartList *** *)
property RawPartCount: Integer read GetPartCount write SetRawPartCount;
procedure RawChangePartCount(ANewCount: Integer);
property RawParts[AnIndex: Integer]: TStringBuilderPart read GetParts write SetRawParts;
property RawPartsPtr[AnIndex: Integer]: PStringBuilderPart read GetRawPartsPtr;
// Set the "RawAsString" of a part that is already in the list (if it has no value yet)
property RawPartsAsString[AnIndex: Integer]: String read GetPartsAsString write SetRawPartsAsString;
(* *** List ... *** *)
property RawPrefix: String read GetPrefix write SetRawPrefix;
property RawPostfix: String read GetPostfix write SetRawPostfix;
property RawSeparator: String read GetSeparator write SetRawSeparator;
end;
function ExtractProcResFromMethod(AMethodRes: TWatchResultData): TWatchResultData; function ExtractProcResFromMethod(AMethodRes: TWatchResultData): TWatchResultData;
function ExtractInstanceResFromMethod(AMethodRes: TWatchResultData): TWatchResultData; function ExtractInstanceResFromMethod(AMethodRes: TWatchResultData): TWatchResultData;
@ -47,5 +183,503 @@ begin
Result := AMethodRes.Fields[1].Field; Result := AMethodRes.Fields[1].Field;
end; end;
{ TStringBuilderPart }
function TStringBuilderPart.GetAsString: String;
begin
if FType = sbfString then
Result := String(FData)
else
Result := '';
end;
function TStringBuilderPart.GetStringCount: Integer;
begin
if (FType = sbfStringList) and (FData <> nil) then
Result := PHeader(FData)^.FCount
else
Result := 0;
end;
function TStringBuilderPart.GetStrings(AnIndex: Integer): String;
begin
Result := PString(FData + HD_SIZE)[AnIndex];
end;
function TStringBuilderPart.GetPartCount: Integer;
begin
if (FType = sbfPartList) and (FData <> nil) then
Result := PHeader(FData)^.FCount
else
Result := 0;
end;
function TStringBuilderPart.GetParts(AnIndex: Integer): TStringBuilderPart;
begin
Result := PStringBuilderPart(FData + HD_SIZE)[AnIndex];
end;
function TStringBuilderPart.GetPartsAsString(AnIndex: Integer): String;
var
p: PStringBuilderPart;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
if p^.FType = sbfString then
Result := String(p^.FData)
else
Result := '';
end;
function TStringBuilderPart.GetPartsTotalLen(AnIndex: Integer): Integer;
var
p: PStringBuilderPart;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
if p^.FType = sbfString then
Result := Length(String(p^.FData))
else
Result := PHeader(p^.FData)^.FTotalLen;
end;
function TStringBuilderPart.GetPostfix: String;
begin
if (FType <> sbfString) and (FData <> nil) then
Result := PHeader(FData)^.FPostfix
else
Result := '';
end;
function TStringBuilderPart.GetPrefix: String;
begin
if (FType <> sbfString) and (FData <> nil) then
Result := PHeader(FData)^.FPostfix
else
Result := '';
end;
function TStringBuilderPart.GetSeparator: String;
begin
if (FType <> sbfString) and (FData <> nil) then
Result := PHeader(FData)^.FSeparator
else
Result := '';
end;
function TStringBuilderPart.GetRawPartsPtr(AnIndex: Integer): PStringBuilderPart;
begin
Result := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
end;
function TStringBuilderPart.GetTotalLen: integer;
begin
if (FType <> sbfString) and (FData <> nil) then
Result := PHeader(FData)^.FTotalLen
else
Result := Length(string(FData));
end;
procedure TStringBuilderPart.SetAsString(const AValue: String);
begin
if FType <> sbfString then FreeAll;
FType := sbfString;
String(FData) := AValue;
end;
procedure TStringBuilderPart.SetStringCount(AValue: Integer);
begin
if FType = sbfStringList then begin
ChangeStringCount(AValue, PHeader(FData)^.FCount > 2 * AValue);
end
else begin
if FData <> nil then
FreeAll;
FType := sbfStringList;
FData := AllocMem(HD_SIZE + AValue * SizeOf(string));
PHeader(FData)^.FCount := AValue;
end;
end;
procedure TStringBuilderPart.SetStrings(AnIndex: Integer; const AValue: String);
var
ps: PString;
begin
ps := @PString(FData + HD_SIZE)[AnIndex];
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(ps^) + Length(AValue);
ps^ := AValue;
end;
procedure TStringBuilderPart.SetPartCount(AValue: Integer);
begin
if FType = sbfPartList then begin
ChangePartCount(AValue, PHeader(FData)^.FCount > 2 * AValue);
end
else begin
if FData <> nil then
FreeAll;
FType := sbfPartList;
FData := AllocMem(HD_SIZE + AValue * SizeOf(TStringBuilderPart));
PHeader(FData)^.FCount := AValue;
end;
end;
procedure TStringBuilderPart.SetParts(AnIndex: Integer; AValue: TStringBuilderPart);
var
pp: PStringBuilderPart;
begin
pp := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - pp^.TotalLen + AValue.TotalLen;
pp^ := AValue;
end;
procedure TStringBuilderPart.SetPartsAsString(AnIndex: Integer; const AValue: String);
var
p: PStringBuilderPart;
t: Integer;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
t := PHeader(FData)^.FTotalLen;
if p^.FType <> sbfString then begin
t := t - + p^.TotalLen;
p^.FreeAll;
end
else
t := t - Length(String(p^.FData));
p^.FType := sbfString;
String(p^.FData) := AValue;
t := t + Length(AValue);
PHeader(FData)^.FTotalLen := t;
end;
procedure TStringBuilderPart.SetPostfix(const AValue: String);
begin
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(PHeader(FData)^.FPostfix) + Length(AValue);
PHeader(FData)^.FPostfix := AValue;
end;
procedure TStringBuilderPart.SetPrefix(const AValue: String);
begin
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen - Length(PHeader(FData)^.FPrefix) + Length(AValue);
PHeader(FData)^.FPrefix := AValue;
end;
procedure TStringBuilderPart.SetSeparator(const AValue: String);
begin
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + (Length(AValue) - Length(PHeader(FData)^.FSeparator)) * (PHeader(FData)^.FCount - 1);
PHeader(FData)^.FSeparator := AValue;
end;
procedure TStringBuilderPart.SetRawAsString(const AValue: String);
begin
FType := sbfString;
FData := nil;
String(FData) := AValue;
end;
procedure TStringBuilderPart.SetRawStringCount(AValue: Integer);
begin
FType := sbfStringList;
FData := GetMem(HD_SIZE + AValue * SizeOf(string));
FillChar(FData^,HD_SIZE,0);
PHeader(FData)^.FCount := AValue;
end;
procedure TStringBuilderPart.SetRawStrings(AnIndex: Integer; const AValue: String);
begin
PString(FData + HD_SIZE)[AnIndex] := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
procedure TStringBuilderPart.SetRawPartCount(AValue: Integer);
begin
FType := sbfPartList;
FData := GetMem(HD_SIZE + AValue * SizeOf(TStringBuilderPart));
FillChar(FData^,HD_SIZE,0);
PHeader(FData)^.FCount := AValue;
end;
procedure TStringBuilderPart.SetRawParts(AnIndex: Integer; const AValue: TStringBuilderPart);
begin
PStringBuilderPart(FData + HD_SIZE)[AnIndex] := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + AValue.TotalLen;
end;
procedure TStringBuilderPart.SetRawPartsAsString(AnIndex: Integer; const AValue: String);
var
p: PStringBuilderPart;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
p^.FType := sbfString;
p^.FData := nil;
String(p^.FData) := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
procedure TStringBuilderPart.SetRawPostfix(const AValue: String);
begin
PHeader(FData)^.FPostfix := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
procedure TStringBuilderPart.SetRawPrefix(const AValue: String);
begin
PHeader(FData)^.FPrefix := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
procedure TStringBuilderPart.SetRawSeparator(const AValue: String);
begin
PHeader(FData)^.FSeparator := AValue;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue) * (PHeader(FData)^.FCount - 1);
end;
procedure TStringBuilderPart.DoFreeAll;
var
ps: PString;
pp: PStringBuilderPart;
i: Integer;
begin
case FType of
//sbfString:
// Finalize(String(FData));
sbfStringList: begin
Finalize(PHeader(FData)^.FPrefix);
Finalize(PHeader(FData)^.FPostfix);
Finalize(PHeader(FData)^.FSeparator);
ps := PString(FData + HD_SIZE);
for i := 0 to PHeader(FData)^.FCount - 1 do begin
Finalize(ps^);
inc(ps);
end;
Freemem(FData);
end;
sbfPartList: begin
Finalize(PHeader(FData)^.FPrefix);
Finalize(PHeader(FData)^.FPostfix);
Finalize(PHeader(FData)^.FSeparator);
pp := PStringBuilderPart(FData + HD_SIZE);
for i := 0 to PHeader(FData)^.FCount - 1 do begin
if pp^.FType = sbfString then
Finalize(String(pp^.FData))
else
//if pp^.FData <> nil then
pp^.DoFreeAll;
inc(pp);
end;
Freemem(FData);
end;
end;
end;
procedure TStringBuilderPart.WriteTo(var ADest: PChar);
var
ps: PString;
pp: PStringBuilderPart;
i, c: Integer;
txt: PChar;
len: Integer;
begin
if FData = nil then
exit;
case FType of
sbfString: begin
len := Length(String(FData));
move(FData^, ADest^, len);
inc(ADest, len);
end;
sbfStringList: begin
len := Length(PHeader(FData)^.FPrefix);
if len > 0 then begin
move(PChar(PHeader(FData)^.FPrefix)^, ADest^, len);
inc(ADest, len)
end;
len := Length(PHeader(FData)^.FSeparator);
ps := PString(FData + HD_SIZE);
c := PHeader(FData)^.FCount;
if (c > 1) and (len > 0) then begin
txt := PChar(PHeader(FData)^.FSeparator);
for i := c - 2 downto 0 do begin
move(pchar(ps^)^, ADest^, Length(String(ps^)));
inc(ADest, Length(ps^));
inc(ps);
move(txt^, ADest^, len);
inc(ADest, len)
end;
move(pchar(ps^)^, ADest^, Length(String(ps^)));
inc(ADest, Length(ps^));
end
else begin
for i := c - 1 downto 0 do begin
move(pchar(ps^)^, ADest^, Length(String(ps^)));
inc(ADest, Length(ps^));
inc(ps);
end;
end;
len := Length(PHeader(FData)^.FPostfix);
if len > 0 then begin
move(PChar(PHeader(FData)^.FPostfix)^, ADest^, len);
inc(ADest, len)
end;
end;
sbfPartList: begin
len := Length(PHeader(FData)^.FPrefix);
if len > 0 then begin
move(PChar(PHeader(FData)^.FPrefix)^, ADest^, len);
inc(ADest, len)
end;
len := Length(PHeader(FData)^.FSeparator);
pp := PStringBuilderPart(FData + HD_SIZE);
c := PHeader(FData)^.FCount;
if (c > 1) and (len > 0) then begin
txt := PChar(PHeader(FData)^.FSeparator);
for i := c - 2 downto 0 do begin
pp^.WriteTo(ADest);
inc(pp);
move(txt^, ADest^, len);
inc(ADest, len)
end;
pp^.WriteTo(ADest);
end
else begin
for i := c- 1 downto 0 do begin
pp^.WriteTo(ADest);
inc(pp);
end;
end;
len := Length(PHeader(FData)^.FPostfix);
if len > 0 then begin
move(PChar(PHeader(FData)^.FPostfix)^, ADest^, len);
inc(ADest, len)
end;
end;
end;
end;
procedure TStringBuilderPart.Init;
begin
FData := Nil;
end;
procedure TStringBuilderPart.FreeAll;
begin
if FData = nil then
exit;
if FType = sbfString then
Finalize(String(FData))
else
DoFreeAll;
FData := nil;
end;
function TStringBuilderPart.GetFullString: String;
var
p: PChar;
begin
if FData = nil then
exit('');
if FType = sbfString then
exit(string(FData));
SetLength(Result, PHeader(FData)^.FTotalLen);
p := pchar(Result);
WriteTo(p);
assert(p = Pchar(Result)+Length(Result), 'TStringBuilderPart.GetFullString: p = Pchar(Result)+Length(Result)');
end;
procedure TStringBuilderPart.ChangeStringCount(ANewCount: Integer; ATrim: Boolean);
var
i, t: Integer;
ps: PString;
begin
t := PHeader(FData)^.FTotalLen;
ps := @PString(FData + HD_SIZE)[ANewCount];
for i := ANewCount to PHeader(FData)^.FCount -1 do begin
t := t - Length(ps^);
ps^ := '';
inc(ps);
end;
if ATrim or (ANewCount > PHeader(FData)^.FCount) then
FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(string));
t := t + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
PHeader(FData)^.FTotalLen := t;
PHeader(FData)^.FCount := ANewCount;
end;
procedure TStringBuilderPart.ChangePartCount(ANewCount: Integer; ATrim: Boolean);
var
i, t: Integer;
pp: PStringBuilderPart;
begin
t := PHeader(FData)^.FTotalLen;
pp := @PStringBuilderPart(FData + HD_SIZE)[ANewCount];
for i := ANewCount to PHeader(FData)^.FCount -1 do begin
t := t - pp^.TotalLen;
pp^.FreeAll;
inc(pp);
end;
if ATrim or (ANewCount > PHeader(FData)^.FCount) then
FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(TStringBuilderPart));
t := t + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
PHeader(FData)^.FTotalLen := t;
PHeader(FData)^.FCount := ANewCount;
end;
procedure TStringBuilderPart.PrependToPart(AnIndex: Integer; const AValue: String);
var
p: PStringBuilderPart;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
case p^.FType of
sbfString: String(p^.FData) := AValue + String(p^.FData);
sbfStringList,
sbfPartList: begin
PHeader(p^.FData)^.FPrefix := AValue + PHeader(p^.FData)^.FPrefix;
PHeader(p^.FData)^.FTotalLen := PHeader(p^.FData)^.FTotalLen + Length(AValue);
end;
end;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
procedure TStringBuilderPart.AppendToPart(AnIndex: Integer; const AValue: String);
var
p: PStringBuilderPart;
begin
p := @PStringBuilderPart(FData + HD_SIZE)[AnIndex];
case p^.FType of
sbfString: String(p^.FData) := String(p^.FData) + AValue;
sbfStringList,
sbfPartList: begin
PHeader(p^.FData)^.FPostfix := PHeader(p^.FData)^.FPostfix + AValue;
PHeader(p^.FData)^.FTotalLen := PHeader(p^.FData)^.FTotalLen + Length(AValue);
end;
end;
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(AValue);
end;
function TStringBuilderPart.RawAsStringPtr: PString;
begin
FType := sbfString;
FData := nil;
Result := PString(@FData )
end;
procedure TStringBuilderPart.RawChangeStringCount(ANewCount: Integer);
begin
if ANewCount > PHeader(FData)^.FCount then
FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(string));
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
PHeader(FData)^.FCount := ANewCount;
end;
procedure TStringBuilderPart.RawChangePartCount(ANewCount: Integer);
begin
if ANewCount > PHeader(FData)^.FCount then
FData := ReAllocMem(FData, HD_SIZE + ANewCount * SizeOf(TStringBuilderPart));
PHeader(FData)^.FTotalLen := PHeader(FData)^.FTotalLen + Length(PHeader(FData)^.FSeparator) * (ANewCount - PHeader(FData)^.FCount);
PHeader(FData)^.FCount := ANewCount;
end;
end. end.