paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-21 00:41:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: shorten the output for pchar like types (strings in dwarf 2)

Browse Source 
git-svn-id: trunk@63399 -
This commit is contained in:
martin 2020-06-19 21:05:17 +00:00
parent 4b28988db2
commit 21f849d337
4 changed files with 60 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/fpdebug/fppascalbuilder.pas
View File

@ -739,15 +739,28 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
end;
end;
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
if ADisplayFormat = wdfPointer then exit; // no data
if svfString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + QuoteText(AValue.AsString)
if ADisplayFormat = wdfPointer then begin
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
exit; // no data
end;
(* In Dwarf 2 Strings are Pchar => do not add the typename.
TODO: In Dwarf 3 this should be true pchar, maybe add typename?
*)
if svfString in AValue.FieldFlags then begin
if v <> 0 then
APrintedValue := APrintedValue + '^: ' + QuoteText(AValue.AsString);
end
else
if svfWideString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + QuoteWideText(AValue.AsWideString);
if svfWideString in AValue.FieldFlags then begin
if v <> 0 then
APrintedValue := APrintedValue + '^: ' + QuoteWideText(AValue.AsWideString)
end
else
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')'; // no typeinfo for strings/pchar
Result := True;
end;

14
components/fpdebug/fppascalparser.pas
View File

@ -588,6 +588,8 @@ type
function GetTypeInfo: TFpSymbol; override;
function GetDataAddress: TFpDbgMemLocation; override;
function GetMember(AIndex: Int64): TFpValue; override;
function GetAsString: AnsiString; override;
function GetAsWideString: WideString; override;
public
constructor Create(AValue: TFpValue; AContext: TFpDbgInfoContext);
destructor Destroy; override;
@ -923,6 +925,8 @@ end;
function TFpPasParserValueAddressOf.GetFieldFlags: TFpValueFieldFlags;
begin
Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress];
if FValue.Kind in [skChar] then
Result := Result + FValue.FieldFlags * [svfString, svfWideString];
end;
function TFpPasParserValueAddressOf.GetAsInteger: Int64;
@ -998,6 +1002,16 @@ begin
Result := Tmp;
end;
function TFpPasParserValueAddressOf.GetAsString: AnsiString;
begin
Result := FValue.AsString;
end;
function TFpPasParserValueAddressOf.GetAsWideString: WideString;
begin
Result := FValue.AsWideString;
end;
constructor TFpPasParserValueAddressOf.Create(AValue: TFpValue;
AContext: TFpDbgInfoContext);
begin

24
components/lazdebuggers/lazdebuggerfp/test/testwatches.pas
View File

@ -1465,6 +1465,7 @@ end;
var
i, Thread: Integer;
v1, v2: String;
p: SizeInt;
begin
AssertTrue('Same count', t1.Count = t2.Count);
t1.EvaluateWatches;
@ -1478,6 +1479,13 @@ end;
if (length(v1) < Length(v2)) and (pos(') ', v2) = Length(v1)) then
v2 := copy(v2, 1, Length(v1));
// v1 may have a single deref value at the end
if (length(v1) <> Length(v2)) and (pos('^: ', v1) = pos('^: ', v2)) then begin
p := pos('^: ', v1);
v1 := copy(v1, 1, p);
v2 := copy(v2, 1, p);
end;
TestEquals(t1.Tests[i]^.TstTestName + ': ' + t1.Tests[i]^.TstWatch.Expression + ' <> ' + t2.Tests[i]^.TstWatch.Expression,
v1, v2);
end;
@ -1733,16 +1741,16 @@ procedure TTestWatches.TestWatchesTypeCast;
StartIdx := t.Count; // tlConst => Only eval the watch. No tests
val := t2.Tests[0]^.TstWatch.Values[Thread, 0].Value;
t.Add(AName+' Int', 'PtrUInt('+p+'Instance1'+e+')', weCardinal(StrToQWordDef(val, qword(-7)), 'PtrUInt', -1));
t.Add(AName+' TClass1', 'TClass1('+p+'Instance1_Int'+e+')', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1('+val+')', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1(Pointer('+p+'Instance1_Int'+e+'))', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1(Pointer('+val+'))', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1('+p+'Instance1_Int'+e+')', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1('+val+')', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1(Pointer('+p+'Instance1_Int'+e+'))', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' TClass1', 'TClass1(Pointer('+val+'))', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
val := t2.Tests[1]^.TstWatch.Values[Thread, 0].Value;
t.Add(AName+' PTxInstance1', 'PTxInstance1(@'+p+'Instance1'+e+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1('+val+')^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer(@'+p+'Instance1'+e+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer('+val+'))^', weMatch('FAnsi *=[ $0-9A-F()]*'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1(@'+p+'Instance1'+e+')^', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1('+val+')^', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer(@'+p+'Instance1'+e+'))^', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
t.Add(AName+' PTxInstance1', 'PTxInstance1(Pointer('+val+'))^', weMatch('FAnsi *=[ $0-9A-F()]*\^?:? *'''+AChr1+'T', skClass));
val := t2.Tests[2]^.TstWatch.Values[Thread, 0].Value;

12
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -1612,14 +1612,15 @@ begin
tn := '.*';
if (tn <> '') then begin
if (Expect.ExpTextData = '') and
FTest.Matches('^'+tn+'\(nil\)', v)
FTest.Matches('^'+tn+'\(nil\)', v) or
FTest.Matches('^nil$', v) // new format, no typename
then
v := ''''''
else
if FTest.Matches('^'+tn+'\(\$[0-9a-fA-F]+\) ', v) then
delete(v, 1, pos(') ', v)+1)
else
if FTest.Matches('^\$[0-9a-fA-F]+ ', v) then
if FTest.Matches('^\$[0-9a-fA-F]+(\^:)? ', v) then
delete(v, 1, pos(' ', v));
end
else begin
@ -1670,6 +1671,13 @@ begin
tn := '.*';
e := '(\$[0-9a-fA-F]*|nil)';
if (tn <> '') and
(Length(Expect.ExpSubResults) = 1) and
(Expect.ExpSubResults[0].ExpResultKind in [rkChar, rkAnsiString, rkWideString, rkShortString]) and
(not FTest.Matches(tn+'\(', AContext.WatchVal.Value))
then
tn := ''; // char pointer to not (always?) include the type
if tn <> '' then
e := tn+'\('+e+'\)';
e := '^'+e;