Debugger: Improved shortstring detection. Started to handle strings with utf8 content

git-svn-id: trunk@41233 -
This commit is contained in:
martin 2013-05-17 10:26:51 +00:00
parent 022da54a97
commit 1d623aeab7
5 changed files with 150 additions and 40 deletions

View File

@ -269,7 +269,8 @@ type
): Boolean; overload;
procedure DoTimeoutFeedback;
function ProcessResult(var AResult: TGDBMIExecResult; ATimeOut: Integer = -1): Boolean;
function ProcessGDBResultText(S: String): String;
function ProcessGDBResultText(S: String; NoLeadingTab: Boolean = False;
NoBackSlashRemove: Boolean = False): String;
function GetStackDepth(MaxDepth: integer): Integer;
function FindStackFrame(FP: TDBGPtr; StartAt, MaxDepth: Integer): Integer;
function GetFrame(const AIndex: Integer): String;
@ -10790,7 +10791,8 @@ begin
until not FTheDebugger.DebugProcessRunning;
end;
function TGDBMIDebuggerCommand.ProcessGDBResultText(S: String): String;
function TGDBMIDebuggerCommand.ProcessGDBResultText(S: String;
NoLeadingTab: Boolean = False; NoBackSlashRemove: Boolean = False): String;
var
Trailor: String;
n, len, idx: Integer;
@ -10799,9 +10801,11 @@ begin
// don't use ' as end terminator, there might be one as part of the text
// since ' will be the last char, simply strip it.
if pos('\t ', s) > 0
then S := GetPart(['\t '], [], S)
else S := GetPart(['\t'], [], S); // GDB 7.5 no longer has the space
if (not NoLeadingTab) then begin
S := GetPart(['\t'], [], S);
if (length(S) > 0) and (S[1] = ' ') then
delete(S,1,1);
end;
// Scan the string
len := Length(S);
@ -10823,8 +10827,10 @@ begin
Inc(idx);
if idx > len then Break;
if S[idx] <> '''' then Break;
inc(n);
Result[n] := ''''; // must keep both quotes
end;
'\' : begin
'\' : if not NoBackSlashRemove then begin
Inc(idx);
if idx > len then Break;
case S[idx] of
@ -10877,7 +10883,7 @@ begin
Dec(v);
end;
end;
else
else // Should not get here
// Debugger has returned something we don't know of
// Append the remainder to our parsed result
Delete(S, 1, idx - 1);
@ -11803,33 +11809,53 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
var
TypeInfoFlags: TGDBTypeCreationFlags;
function MakePrintable(const AString: String): String;
function MakePrintable(const AString: String): String; // Todo: Check invalid utf8
// Astring should not have quotes
var
n: Integer;
n, l, u: Integer;
InString: Boolean;
procedure ToggleInString;
begin
InString := not InString;
Result := Result + '''';
end;
begin
Result := '';
InString := False;
for n := 1 to Length(AString) do
n := 1;
l := Length(AString);
while n <= l do
//for n := 1 to Length(AString) do
begin
case AString[n] of
' '..#127, #128..#255: begin
if not InString
then begin
InString := True;
Result := Result + '''';
end;
' '..#127: begin
if not InString then
ToggleInString;
Result := Result + AString[n];
//if AString[n] = '''' then Result := Result + '''';
end;
else
if InString
then begin
InString := False;
Result := Result + '''';
#192..#255: begin // Maybe utf8
u := UTF8CharacterLength(@AString[n]);
if (u > 0) and (n+u-1 <= l) then begin
if not InString then
ToggleInString;
Result := Result + copy(AString, n, u);
n := n + u - 1;
end
else begin
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
end;
else
if InString then
ToggleInString;
Result := Result + Format('#%d', [Ord(AString[n])]);
end;
inc(n);
end;
if InString
then Result := Result + '''';
@ -12602,11 +12628,14 @@ var
of
0, 1, 2: begin // 'char', 'character', 'ansistring'
// check for addr 'text' / 0x1234 'abc'
i := length(addrtxt);
if (i+3 <= length(FTextValue)) and (FTextValue[i+2] ='''')
and (FTextValue[length(FTextValue)] ='''')
i := length(addrtxt)+1;
if (i <= length(FTextValue)) and (FTextValue[i] = ' ') then inc(i); // skip 1 or 2 spaces after addr
if (i <= length(FTextValue)) and (FTextValue[i] = ' ') then inc(i);
if (i <= length(FTextValue)) and (FTextValue[i] in ['''', '#'])
then
FTextValue := copy(FTextValue, i+2, length(FTextValue) - i - 1)
FTextValue := MakePrintable(ProcessGDBResultText(
copy(FTextValue, i, length(FTextValue) - i + 1), True, True))
else
if Addr = 0
then
@ -12687,7 +12716,10 @@ var
if ResultInfo.TypeName = 'CURRENCY' then
FTextValue := FormatCurrency(FTextValue)
else
if (ResultInfo.TypeName = '&ShortString') then
if ResultInfo.TypeName = 'ShortString' then
FTextValue := MakePrintable(ProcessGDBResultText(FTextValue, True, True))
else
if (ResultInfo.TypeName = '&ShortString') then // should no longer happen
FTextValue := GetStrValue('ShortString(%s)', [AnExpression]) // we have an address here, so we need to typecast
else
if saDynArray in ResultInfo.Attributes then // may also be a string

View File

@ -352,6 +352,7 @@ type
FExpression, FPTypeExpression, FOrigExpression: string;
FHasStringExprEvaluatedAsText: Boolean;
FCreationFlags: TGDBTypeCreationFlags;
FMaybeShortString: Boolean;
// Value-Eval
FExprEvaluatedAsText: String;
@ -2110,6 +2111,7 @@ begin
inherited Init;
FProcessState := gtpsFinished;
FParsedExpression := nil;
FMaybeShortString := False;
end;
function TGDBType.DebugString: String;
@ -2261,17 +2263,6 @@ var
S, S1, S2: String;
Field: TDBGField;
begin
if (FTypeName = 'Variant') or
(FTypeName = 'VARIANT') then
FKind := skVariant
else
if (FTypeName = 'ShortString') or
(FTypeName = 'SHORTSTRING') or
(FTypeName = '&ShortString') then
FKind := skSimple
else
FKind := skRecord;
FFields := TDBGFields.Create;
InitLinesFrom(FReqResults[gptrPTypeExpr]);
@ -2287,6 +2278,28 @@ var
);
FFields.Add(Field);
end;
FMaybeShortString := (FFields.Count = 2) and // shortstring have 2 fields: length and st
(lowercase(FFields[0].Name) = 'length') and
(lowercase(FFields[1].Name) = 'st');
if (FTypeName = 'Variant') or
(FTypeName = 'VARIANT') then
FKind := skVariant
else
if (FTypeName = 'ShortString') or
(FTypeName = 'SHORTSTRING') or
(FTypeName = '&ShortString')
then begin
if (gtcfExprEvaluate in FCreationFlags) then
FMaybeShortString := True // will be checked later
else
FKind := skSimple
end
else
FKind := skRecord;
end;
{%endregion * Record * }
@ -2629,7 +2642,7 @@ var
var
ResultList: TGDBMINameValueList;
begin
ResultList := TGDBMINameValueList.Create(AGdbDesc);
ResultList := TGDBMINameValueList.Create(AGdbDesc); // TODO: this removes \\ to single \. BUt does not deal with gdb \r\n stuff
Result := ResultList.Values[AField];
//FTextValue := DeleteEscapeChars(FTextValue);
ResultList.Free;
@ -3281,7 +3294,17 @@ begin
end;
if Result
then FProcessState := gtpsFinished;
then begin
if FHasExprEvaluatedAsText and FMaybeShortString and
(length(FExprEvaluatedAsText) > 0) and
(FExprEvaluatedAsText[1] in ['''', '#']) // not a record struct
then begin
FTypeName := 'ShortString';
FKind := skSimple;
end;
FProcessState := gtpsFinished;
end;
if FFirstProcessingSubType <> nil then
MergeSubProcessRequests

View File

@ -128,7 +128,7 @@
VarLongWord := ArgLongWord + 100;
VarQWord := ArgQWord + 100;
VarShortInt := ArgShortInt + 100;
VarShortInt := ArgShortInt + 10;
VarSmallInt := ArgSmallInt + 100;
VarInt := ArgInt + 100;
VarInt64 := ArgInt64 + 100;

View File

@ -410,6 +410,26 @@
VarTStringHolderObj: TStringHolderObj;
VarTStringHolderRec: TStringHolderRec;
const
ConstUtf8TextAnsi: AnsiString = 'a üü1'' \\t 2 \t 3'#9'4'#13'5\n6';
ConstUtf8TextShortStr: ShortString = 'a üü1'' \\t 2 \t 3'#9'4'#13'5\n6';
ConstUtf8TextShort: String[40] = 'a üü1'' \\t 2 \t 3'#9'4'#13'5\n6';
ConstUtf8TextAnsi2: AnsiString = 'üü1'; // start with utf8
ConstUtf8TextShortStr2: ShortString = 'üü1';
ConstUtf8TextShort2: String[40] = 'üü1';
ConstUtf8TextAnsiBad: AnsiString = 'a '#170'b';
ConstUtf8TextShortStrBad: ShortString = 'a '#170'b';
ConstUtf8TextShortBad: String[40] = 'a '#170'b';
var
VarUtf8TextAnsi, VarUtf8TextAnsi2: AnsiString;
VarUtf8TextShort, VarUtf8TextShort2: String[40];
VarUtf8TextShortStr, VarUtf8TextShortStr2: ShortString;
VarUtf8TextAnsiBad: AnsiString;
VarUtf8TextShortBad: String[40];
VarUtf8TextShortStrBad: ShortString;
{$ENDIF}
{$IFDEF Global_Var}
@ -531,6 +551,17 @@
VarACharArray10B0[1] := 'a';
VarACharArray10B1[1] := 'b';
VarUtf8TextAnsi := ConstUtf8TextAnsi;
VarUtf8TextShort := ConstUtf8TextShort;
VarUtf8TextShortStr := ConstUtf8TextShortStr;
VarUtf8TextAnsi2 := ConstUtf8TextAnsi2;
VarUtf8TextShort2 := ConstUtf8TextShort2;
VarUtf8TextShortStr2 := ConstUtf8TextShortStr2;
VarUtf8TextAnsiBad := ConstUtf8TextAnsiBad;
VarUtf8TextShortBad := ConstUtf8TextShortBad;
VarUtf8TextShortStrBad := ConstUtf8TextShortStrBad;
{$ENDIF}
{$IFDEF Global_Body}

View File

@ -1174,6 +1174,30 @@ begin
Add('ArgTMyAnsiString', wdfMemDump, ': 4d 79 41 6e 73 69 00', skPOINTER, '^(TMy)?AnsiString$', [fTpMtch]);
// Utf8
// a single ', must appear double ''
// reg ex needs \\ for \
r:=AddStringFmtDef ('ConstUtf8TextAnsi', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'AnsiString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShort', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'ShortString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShortStr', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'ShortString', []);
r:=AddStringFmtDef ('VarUtf8TextAnsi', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'AnsiString', []);
r:=AddShortStrFmtDef('VarUtf8TextShort', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'ShortString', []);
r:=AddShortStrFmtDef('VarUtf8TextShortStr', 'a üü1'''' \\\\t 2 \\t 3''#9''4''#13''5\\n6', 'ShortString', []);
r:=AddStringFmtDef ('ConstUtf8TextAnsi2', 'üü1', 'AnsiString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShort2', 'üü1', 'ShortString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShortStr2', 'üü1', 'ShortString', []);
r:=AddStringFmtDef ('VarUtf8TextAnsi2', 'üü1', 'AnsiString', []);
r:=AddShortStrFmtDef('VarUtf8TextShort2', 'üü1', 'ShortString', []);
r:=AddShortStrFmtDef('VarUtf8TextShortStr2', 'üü1', 'ShortString', []);
r:=AddStringFmtDef ('ConstUtf8TextAnsiBad', 'a ''#170''b', 'AnsiString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShortBad', 'a ''#170''b', 'ShortString', []);
r:=AddShortStrFmtDef('ConstUtf8TextShortStrBad', 'a ''#170''b', 'ShortString', []);
r:=AddStringFmtDef ('VarUtf8TextAnsiBad', 'a ''#170''b', 'AnsiString', []);
r:=AddShortStrFmtDef('VarUtf8TextShortBad', 'a ''#170''b', 'ShortString', []);
r:=AddShortStrFmtDef('VarUtf8TextShortStrBad', 'a ''#170''b', 'ShortString', []);
{%endregion * Strings * }
{%region * Simple * }