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

Debugger (gdb): Fix Debug-Inspector for dwarf3. Match fieldnames case insensitive. Depending on gdb, try to find the MixedCase version of any name. Issue #0034453

Browse Source 
git-svn-id: branches/fixes_2_0@59369 -
This commit is contained in:
mattias 2018-10-27 09:45:10 +00:00
parent d863447db2
commit 268dbdf735
2 changed files with 26 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -538,11 +538,11 @@ type
ALocation: TDBGFieldLocation; AFlags: TDBGFieldFlags = []; ALocation: TDBGFieldLocation; AFlags: TDBGFieldFlags = [];
AClassName: String = ''); AClassName: String = '');
destructor Destroy; override; destructor Destroy; override;
property Name: String read FName; property Name: String read FName write FName;
property DBGType: TDBGType read FDBGType; property DBGType: TDBGType read FDBGType;
property Location: TDBGFieldLocation read FLocation; property Location: TDBGFieldLocation read FLocation;
property Flags: TDBGFieldFlags read FFlags; property Flags: TDBGFieldFlags read FFlags;
property ClassName: String read FClassName; // the class in which the field was declared property ClassName: String read FClassName write FClassName; // the class in which the field was declared
end; end;
{ TDBGFields } { TDBGFields }

32
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -11997,7 +11997,7 @@ var
procedure PutValuesInTypeRecord(const AType: TDBGType; const ATextInfo: String); procedure PutValuesInTypeRecord(const AType: TDBGType; const ATextInfo: String);
var var
GDBParser: TGDBStringIterator; GDBParser: TGDBStringIterator;
Payload: String; Payload, s: String;
Composite: Boolean; Composite: Boolean;
StopChar: Char; StopChar: Char;
j: Integer; j: Integer;
@ -12023,11 +12023,16 @@ var
Break; Break;
end; end;
if Payload <> AType.Fields[j].Name s := uppercase(AType.Fields[j].Name);
if uppercase(Payload) <> s
then begin then begin
debugln(DBGMI_STRUCT_PARSER, 'Field name does not match, expected "', AType.Fields[j].Name, '" but found "', Payload,'"'); debugln(DBGMI_STRUCT_PARSER, 'Field name does not match, expected "', AType.Fields[j].Name, '" but found "', Payload,'"');
Break; Break;
end; end;
if (Payload <> AType.Fields[j].Name) and (s = AType.Fields[j].Name) then begin
// gdb returned different case
AType.Fields[j].Name := Payload;
end;
if StopChar <> '=' if StopChar <> '='
then begin then begin
@ -12098,7 +12103,7 @@ var
procedure ProcessAncestor(ATypeName: String); procedure ProcessAncestor(ATypeName: String);
var var
HelpPtr, HelpPtr2: PChar; HelpPtr, HelpPtr2: PChar;
NewName, NewVal: String; NewName, NewVal, Sn, Sc: String;
i: Integer; i: Integer;
NewField: TDBGField; NewField: TDBGField;
begin begin
@ -12138,7 +12143,7 @@ var
while (StartPtr <= EndPtr) and (StartPtr^ <> '}') do begin while (StartPtr <= EndPtr) and (StartPtr^ <> '}') do begin
HelpPtr := StartPtr; HelpPtr := StartPtr;
while (HelpPtr < EndPtr) and not (HelpPtr^ in [' ', '=', ',']) do inc(HelpPtr); while (HelpPtr < EndPtr) and not (HelpPtr^ in [' ', '=', ',']) do inc(HelpPtr);
NewName := uppercase(copy(StartPtr, 1, HelpPtr - StartPtr)); // name of field NewName := copy(StartPtr, 1, HelpPtr - StartPtr); // name of field
StartPtr := HelpPtr; StartPtr := HelpPtr;
SkipSpaces; SkipSpaces;
@ -12159,13 +12164,15 @@ var
NewVal := copy(HelpPtr, 1, HelpPtr2 + 1 - HelpPtr); // name of field NewVal := copy(HelpPtr, 1, HelpPtr2 + 1 - HelpPtr); // name of field
i := AType.Fields.Count - 1; i := AType.Fields.Count - 1;
Sn := UpperCase(NewName);
Sc := UpperCase(ATypeName);
while (i >= 0) while (i >= 0)
and ( (uppercase(AType.Fields[i].Name) <> NewName) and ( (uppercase(AType.Fields[i].Name) <> Sn)
or (uppercase(AType.Fields[i].ClassName) <> ATypeName) ) or (uppercase(AType.Fields[i].ClassName) <> Sc) )
do dec(i); do dec(i);
if i < 0 then begin if i < 0 then begin
if (uppercase(ATypeName) <> 'TOBJECT') or (pos('VPTR', uppercase(NewName)) < 1) then begin if (Sc <> 'TOBJECT') or (pos('VPTR', Sn) < 1) then begin
if not(defFullTypeInfo in FEvalFlags) then begin if not(defFullTypeInfo in FEvalFlags) then begin
NewField := TDBGField.Create(NewName, TGDBType.Create(skSimple, ''), flPublic, [], ''); NewField := TDBGField.Create(NewName, TGDBType.Create(skSimple, ''), flPublic, [], '');
AType.Fields.Add(NewField); AType.Fields.Add(NewField);
@ -12175,8 +12182,17 @@ var
debugln(DBGMI_STRUCT_PARSER, 'WARNING: PutValuesInClass: No field for "' + ATypeName + '"."' + NewName + '"'); debugln(DBGMI_STRUCT_PARSER, 'WARNING: PutValuesInClass: No field for "' + ATypeName + '"."' + NewName + '"');
end; end;
end end
else else begin
if (AType.Fields[i].Name <> NewName) and
(uppercase(AType.Fields[i].Name) = AType.Fields[i].Name)
then
AType.Fields[i].Name := NewName; // Adjust to mixed case
if (AType.Fields[i].ClassName <> ATypeName) and
(uppercase(AType.Fields[i].ClassName) = AType.Fields[i].ClassName)
then
AType.Fields[i].ClassName := ATypeName; // Adjust to mixed case
AType.Fields[i].DBGType.Value.AsString := HexCToHexPascal(NewVal); AType.Fields[i].DBGType.Value.AsString := HexCToHexPascal(NewVal);
end;
if (StartPtr^ <> '}') then inc(StartPtr); if (StartPtr^ <> '}') then inc(StartPtr);
SkipSpaces; SkipSpaces;