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

GdbmiDebugger: Workaround for gdb bug https://sourceware.org/bugzilla/show_bug.cgi?id=16016

Browse Source 
git-svn-id: trunk@61116 -
This commit is contained in:
martin 2019-05-03 15:16:30 +00:00
parent 2b838aacbd
commit 29735fe548
2 changed files with 33 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
components/lazdebuggergdbmi/gdbtypeinfo.pp
View File

@ -433,7 +433,7 @@ type
end;
function ParseTypeFromGdb(const ATypeText: string): TGDBPTypeResult;
function ParseTypeFromGdb(ATypeText: string): TGDBPTypeResult;
function GDBMIMaybeApplyBracketsToExpr(e: string): string;
function dbgs(AFlag: TGDBPTypeResultFlag): string; overload;
@ -818,11 +818,38 @@ begin
end;
end;
function ParseTypeFromGdb(const ATypeText: string): TGDBPTypeResult;
function ParseTypeFromGdb(ATypeText: string): TGDBPTypeResult;
var
i: SizeInt;
i, j: SizeInt;
begin
i := pos('type = ', ATypeText);
if i = 1 then begin
// deal with https://sourceware.org/bugzilla/show_bug.cgi?id=16016
i := i + 7;
if ATypeText[i] = '^' then inc(i);
if (UpperCase(copy(ATypeText, i, 9)) <> 'TOBJECT =') then begin
while (i < Length(ATypeText)) and not(ATypeText[i] in [#0..#32,'=',':']) do
inc(i);
if (UpperCase(copy(ATypeText, i, 9)) = ' = CLASS ') and
(Length(ATypeText) > i + 9) and
(ATypeText[i+9] in [#10, #13])
then begin
j := i + 10;
if (ATypeText[j] in [#10, #13]) then inc(j);
if (uppercase(copy(ATypeText, j, 8)) = ' PUBLIC') and
(Length(ATypeText) > j + 8) and
(ATypeText[j+8] in [#10, #13])
then
j := j + 8
else
j := i + 9;
ATypeText := copy(ATypeText, 1, i+2) + 'record ' + copy(ATypeText, j, Length(ATypeText));
// TODO remove the "public \n" line
end;
end;
i := 1;
end;
if i < 1
then Result := ParseTypeFromGdb(PChar(ATypeText), length(ATypeText))
else Result := ParseTypeFromGdb((@ATypeText[i])+7, length(ATypeText)-6-i);

6
components/lazdebuggergdbmi/test/testgdbtype.pas
View File

@ -528,10 +528,10 @@ begin
R := ParseTypeFromGdb(T);
CheckResult(T+LN, R, ptprkClass, [ptprfPointer, ptprfParamByRef], [], '^&TFOO', 'class : public TOBJECT');
// type = ^TFOO = class
T := 'type = ^TFOO = class '+LN;
// type = ^TOBJECT = class
T := 'type = ^TOBJECT = class '+LN;
R := ParseTypeFromGdb(T);
CheckResult(T, R, ptprkClass, [ptprfPointer, ptprfNoStructure], [], '^TFOO', 'class');
CheckResult(T, R, ptprkClass, [ptprfPointer, ptprfNoStructure], [], '^TOBJECT', 'class');
(* empty happens with @ArgProcedure *)