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

FpDebug: properly encode strings for display (unprintable chars as #$nn)

Browse Source 
git-svn-id: branches/fixes_2_0@59791 -
This commit is contained in:
mattias 2018-12-11 10:20:12 +00:00
parent 89fe1a0fa0
commit 21631e5df3
1 changed files with 122 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
components/fpdebug/fppascalbuilder.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDbgInfo, FpdMemoryTools,
FpErrorMessages, LazLoggerBase;
FpErrorMessages, LazLoggerBase, LazUTF8;
type
TTypeNameFlag = (
@ -86,6 +86,8 @@ function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol; AFlags: TT
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpDbgSymbol;
AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
function QuoteText(AText: Utf8String): UTf8String;
implementation
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol;
@ -445,6 +447,113 @@ begin
ATypeDeclaration := GetIndent + ATypeDeclaration;
end;
function QuoteText(AText: Utf8String): UTf8String;
// TODO: process large text in chunks to avoid allocating huge memory
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: Char;
RPos, SPos, SEnd, QPos: PChar;
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
'''': begin
RPos^ := c; inc(RPos);
RPos^ := c; inc(RPos);
inc(SPos);
end;
#32..Pred(''''), Succ('''')..#126: begin
RPos^ := c; inc(RPos);
inc(SPos);
end;
#192..#223: begin
if ((Byte(SPos[1]) and $C0) <> $80)
then
break; // invalid utf8 -> escape
RPos^ := c; inc(RPos);
RPos^ := SPos[1]; inc(RPos);
inc(SPos, 2);
end;
#224..#239: begin
if ((Byte(SPos[1]) and $C0) <> $80) or ((Byte(SPos[2]) and $C0) <> $80)
then
break; // invalid utf8 -> escape
RPos^ := c; inc(RPos);
RPos^ := SPos[1]; inc(RPos);
RPos^ := SPos[2]; inc(RPos);
inc(SPos, 2);
end;
#240..#247: begin
if ((Byte(SPos[1]) and $C0) <> $80) or ((Byte(SPos[2]) and $C0) <> $80) or
((Byte(SPos[3]) and $C0) <> $80)
then
break; // invalid utf8 -> escape
RPos^ := c; inc(RPos);
RPos^ := SPos[1]; inc(RPos);
RPos^ := SPos[2]; inc(RPos);
RPos^ := SPos[3]; inc(RPos);
inc(SPos, 3);
end;
#0: begin
if (SPos < SEnd) then
break; // need escaping
// END OF TEXT
RPos^ := ''''; inc(RPos);
Assert(RPos-1 <= @Result[Length(Result)], 'RPos-1 <= @Result[Length(Result)]');
SetLength(Result, RPos - @Result[1]);
exit;
end;
else
break; // need escaping
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..#$BF]);
until False;
end;
{ TFpPascalPrettyPrinter }
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
@ -505,7 +614,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
if ADisplayFormat = wdfPointer then exit; // no data
if svfString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + AValue.AsString;
APrintedValue := APrintedValue + ' ' + QuoteText(AValue.AsString);
Result := True;
end;
@ -586,13 +695,22 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
procedure DoChar;
begin
APrintedValue := '''' + AValue.AsString + ''''; // Todo escape
APrintedValue := QuoteText(AValue.AsString);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
end;
Result := True;
end;
procedure DoString;
begin
APrintedValue := QuoteText(AValue.AsString);
if (ppvCreateDbgType in AFlags) then begin
ADBGTypeInfo^ := TDBGType.Create(skString, ResTypeName);
end;
Result := True;
end;
procedure DoFloat;
begin
APrintedValue := FloatToStr(AValue.AsFloat);
@ -889,7 +1007,7 @@ begin
skBoolean: DoBool;
skChar: DoChar;
skFloat: DoFloat;
skString: ;
skString: DoString;
skAnsiString: ;
skCurrency: ;
skVariant: ;