FpDebug: Improve wide/utf8 string/char handling

git-svn-id: trunk@62021 -
This commit is contained in:
martin 2019-10-10 12:19:40 +00:00
parent 690b7498e7
commit cd76eb1ef2
4 changed files with 91 additions and 7 deletions

View File

@ -2000,6 +2000,7 @@ end;
function TFpValueDwarfPointer.GetFieldFlags: TFpValueFieldFlags;
var
t: TFpSymbol;
Size: TFpDbgValueSize;
begin
Result := inherited GetFieldFlags;
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
@ -2007,8 +2008,14 @@ begin
t := TypeInfo;
if (t <> nil) then t := t.TypeInfo;
if (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then // pchar
Result := Result + [svfString]; // data address
if (t <> nil) and (t.Kind = skChar) and IsReadableMem(GetDerefAddress) then begin // pchar
if not t.ReadSize(nil, Size) then
Size := ZeroSize;
case Size.Size of
1: Result := Result + [svfString];
2: Result := Result + [svfWideString];
end;
end;
end;
function TFpValueDwarfPointer.GetDataAddress: TFpDbgMemLocation;

View File

@ -1072,7 +1072,10 @@ end;
function TFpValueDwarfV3FreePascalString.GetFieldFlags: TFpValueFieldFlags;
begin
Result := inherited GetFieldFlags;
Result := Result + [svfString];
case TypeInfo.Kind of
skWideString: Result := Result + [svfWideString];
else Result := Result + [svfString];
end;
end;
function TFpValueDwarfV3FreePascalString.GetAsString: AnsiString;

View File

@ -528,7 +528,7 @@ end;
function TFpValueConstWideChar.GetFieldFlags: TFpValueFieldFlags;
begin
Result := [svfString]
Result := [svfWideString]
end;
function TFpValueConstWideChar.GetAsString: AnsiString;

View File

@ -508,6 +508,74 @@ begin
ATypeDeclaration := GetIndent + ATypeDeclaration;
end;
function QuoteWideText(AText: WideString): WideString;
const
HEXCHR: array [0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
var
Len: Integer;
c: WideChar;
RPos, SPos, SEnd, QPos: PWideChar;
begin
if AText = '' then
exit('''''');
Len := Length(AText);
SetLength(Result, Len * 4); // This is the maximal length result can get
RPos := @Result[1];
SPos := @AText[1];
SEnd := @AText[Len] + 1;
repeat
RPos^ := ''''; inc(RPos);
QPos := RPos;
repeat
c := SPos^;
case c of
#0..#31, #127, #$80..#$9F:
break;
'''': begin
RPos^ := c; inc(RPos);
RPos^ := c; inc(RPos);
inc(SPos);
end;
else begin
RPos^ := c; inc(RPos);
inc(SPos);
end;
end;
c := SPos^;
until False;;
if RPos = QPos then
dec(RPos)
else begin
RPos^ := ''''; inc(RPos);
end;
repeat
c := SPos^;
if (c = #0) and (SPos >= SEnd) then begin
// END OF TEXT
Assert(RPos-1 <= @Result[Length(Result)], 'RPos-1 <= @Result[Length(Result)]');
SetLength(Result, RPos - @Result[1]);
exit;
end;
RPos^ := '#'; inc(RPos);
RPos^ := '$'; inc(RPos);
RPos^ := HEXCHR[Byte(c) >> 4]; inc(RPos);
RPos^ := HEXCHR[Byte(c) and 15]; inc(RPos);
inc(SPos);
c := SPos^;
until not(c in [#0..#31, #127, #$80..#$9F]);
until False;
end;
function QuoteText(AText: Utf8String): UTf8String;
// TODO: process large text in chunks to avoid allocating huge memory
const
@ -675,7 +743,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
if ADisplayFormat = wdfPointer then exit; // no data
if svfString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + QuoteText(AValue.AsString);
APrintedValue := APrintedValue + ' ' + QuoteText(AValue.AsString)
else
if svfWideString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + QuoteWideText(AValue.AsWideString);
Result := True;
end;
@ -842,7 +913,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
procedure DoChar;
begin
APrintedValue := QuoteText(AValue.AsString);
if svfWideString in AValue.FieldFlags then
APrintedValue := QuoteWideText(AValue.AsWideString)
else
APrintedValue := QuoteText(AValue.AsString);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
@ -860,7 +934,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
procedure DoWideString;
begin
APrintedValue := QuoteText(AValue.AsString);
APrintedValue := QuoteWideText(AValue.AsWideString);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skWideString, ResTypeName);
end;