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

+ added classtype support to debugger expression evaluation

Browse Source 
git-svn-id: trunk@13705 -
This commit is contained in:
marc 2008-01-10 01:10:20 +00:00
parent 5f3adf3a3f
commit 83cd44b0c5
2 changed files with 32 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
debugger/gdbmidebugger.pp
View File

@ -978,14 +978,22 @@ begin
if e <> 0 then Exit; if e <> 0 then Exit;
S := Lowercase(ResultInfo.TypeName); S := Lowercase(ResultInfo.TypeName);
if (S = 'character') case StringCase(S, ['character', 'ansistring', '__vtbl_ptr_type']) of
or (S = 'ansistring') 0, 1: begin
then begin if Addr = 0
if Addr = 0 then AResult := ''''''
then AResult := '''''' else AResult := MakePrintable(GetText(Addr));
else AResult := MakePrintable(GetText(Addr)); end;
end 2: begin
else begin if Addr = 0
then AResult := 'nil'
else begin
S := GetClassName(Addr);
if S = '' then S := '???';
AResult := 'class of ' + S + ' ' + AResult;
end;
end;
else
if Addr = 0 if Addr = 0
then AResult := 'nil'; then AResult := 'nil';
if S = 'pointer' then Exit; if S = 'pointer' then Exit;
@ -1001,10 +1009,13 @@ begin
skClass: begin skClass: begin
Val(AResult, addr, e); Val(AResult, addr, e);
if e <> 0 then Exit; if e <> 0 then Exit;
if Addr = 0
S := GetInstanceClassName(Addr); then AResult := 'nil'
if S = '' then S := '???'; else begin
AResult := S + ' ' + AResult; S := GetInstanceClassName(Addr);
if S = '' then S := '???';
AResult := S + ' ' + AResult;
end;
end; end;
end; end;
finally finally

11
debugger/gdbtypeinfo.pp
View File

@ -518,6 +518,9 @@ var
end; end;
end; end;
end; end;
var
HasClass: Boolean;
begin begin
Create; Create;
@ -533,7 +536,9 @@ begin
S := GetPart(['type = '], [' '], Line); S := GetPart(['type = '], [' '], Line);
if S = '' then Exit; if S = '' then Exit;
if Pos(' = class ', Line) > 0 HasClass := Pos(' = class ', Line) > 0;
if HasClass
and (S[2] <> '^') // pointer to class is handled next
then begin then begin
FTypeName := GetPart(['^'], [' '], S); FTypeName := GetPart(['^'], [' '], S);
DoClass; DoClass;
@ -541,7 +546,9 @@ begin
else if S[1] = '^' else if S[1] = '^'
then begin then begin
FKind := skPointer; FKind := skPointer;
FTypeName := GetPart(['^'], [' ='], S); if HasClass
then FTypeName := GetPart(['^^'], [' ='], S)
else FTypeName := GetPart(['^'], [' ='], S);
end end
else if S = 'set' else if S = 'set'
then DoSet then DoSet