paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 20:36:09 +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: trunk@59351 -
This commit is contained in:
martin 2018-10-25 23:47:36 +00:00
parent 58bd48455a
commit 63cf689e1e
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 = [];
AClassName: String = '');
destructor Destroy; override;
property Name: String read FName;
property Name: String read FName write FName;
property DBGType: TDBGType read FDBGType;
property Location: TDBGFieldLocation read FLocation;
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;
{ TDBGFields }

32
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

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