paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 01:11:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* keep stack context till end of evaluation, so type info will be resolved too

Browse Source 
git-svn-id: trunk@22061 -
This commit is contained in:
marc 2009-10-06 23:04:38 +00:00
parent ff95847660
commit fa37d1f012
1 changed files with 84 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
debugger/gdbmidebugger.pp
View File

@ -1712,99 +1712,101 @@ begin
// original // original
frame := -1; frame := -1;
frameidx := -1; frameidx := -1;
repeat
Result := ExecuteCommand('-data-evaluate-expression %s', [S], [cfIgnoreError, cfExternal], R);
if (R.State <> dsError)
then Break;
// check if there is a parentfp and try to evaluate there
if frame = -1
then begin
// store current
ExecuteCommand('-stack-info-frame', [cfIgnoreError], Rtmp);
ResultList.Init(Rtmp.Values);
ResultList.SetPath('frame');
frame := StrToIntDef(ResultList.Values['level'], -1);
if frame = -1 then Break;
frameidx := frame;
end;
until not SelectParentFrame(frameidx);
if frameidx <> frame
then begin
// Restore current frame
ExecuteCommand('-stack-select-frame %u', [frame], [cfIgnoreError]);
end;
ResultList.Init(R.Values);
if R.State = dsError
then AResult := ResultList.Values['msg']
else AResult := ResultList.Values['value'];
AResult := DeleteEscapeChars(AResult);
ResultList.Free;
if R.State = dsError
then Exit;
// Check for strings
ResultInfo := GetGDBTypeInfo(S);
if (ResultInfo = nil) then Exit;
try try
case ResultInfo.Kind of repeat
skPointer: begin Result := ExecuteCommand('-data-evaluate-expression %s', [S], [cfIgnoreError, cfExternal], R);
Val(AResult, addr, e);
if e <> 0 then Exit;
S := Lowercase(ResultInfo.TypeName); if (R.State <> dsError)
case StringCase(S, ['character', 'ansistring', '__vtbl_ptr_type', 'wchar']) of then Break;
0, 1: begin
if Addr = 0 // check if there is a parentfp and try to evaluate there
then AResult := '''''' if frame = -1
else AResult := MakePrintable(GetText(Addr)); then begin
end; // store current
2: begin ExecuteCommand('-stack-info-frame', [cfIgnoreError], Rtmp);
if Addr = 0 ResultList.Init(Rtmp.Values);
then AResult := 'nil' ResultList.SetPath('frame');
else begin frame := StrToIntDef(ResultList.Values['level'], -1);
S := GetClassName(Addr); if frame = -1 then Break;
if S = '' then S := '???'; frameidx := frame;
AResult := 'class of ' + S + ' ' + AResult; end;
until not SelectParentFrame(frameidx);
ResultList.Init(R.Values);
if R.State = dsError
then AResult := ResultList.Values['msg']
else AResult := ResultList.Values['value'];
AResult := DeleteEscapeChars(AResult);
ResultList.Free;
if R.State = dsError
then Exit;
// Check for strings
ResultInfo := GetGDBTypeInfo(S);
if (ResultInfo = nil) then Exit;
try
case ResultInfo.Kind of
skPointer: begin
Val(AResult, addr, e);
if e <> 0 then Exit;
S := Lowercase(ResultInfo.TypeName);
case StringCase(S, ['character', 'ansistring', '__vtbl_ptr_type', 'wchar']) of
0, 1: begin
if Addr = 0
then AResult := ''''''
else AResult := MakePrintable(GetText(Addr));
end; end;
end; 2: begin
3: begin if Addr = 0
// widestring handling then AResult := 'nil'
else begin
S := GetClassName(Addr);
if S = '' then S := '???';
AResult := 'class of ' + S + ' ' + AResult;
end;
end;
3: begin
// widestring handling
if Addr = 0
then AResult := ''''''
else AResult := MakePrintable(GetWideText(Addr));
end;
else
if Addr = 0 if Addr = 0
then AResult := '''''' then AResult := 'nil';
else AResult := MakePrintable(GetWideText(Addr)); if S = 'pointer' then Exit;
if Length(S) = 0 then Exit;
if S[1] = 't'
then begin
S[1] := 'T';
if Length(S) > 1 then S[2] := UpperCase(S[2])[1];
end;
AResult := '^' + S + ' ' + AResult;
end; end;
else end;
skClass: begin
Val(AResult, addr, e);
if e <> 0 then Exit;
if Addr = 0 if Addr = 0
then AResult := 'nil'; then AResult := 'nil'
if S = 'pointer' then Exit; else begin
if Length(S) = 0 then Exit; S := GetInstanceClassName(Addr);
if S[1] = 't' if S = '' then S := '???';
then begin AResult := S + ' ' + AResult;
S[1] := 'T';
if Length(S) > 1 then S[2] := UpperCase(S[2])[1];
end; end;
AResult := '^' + S + ' ' + AResult;
end;
end;
skClass: begin
Val(AResult, addr, e);
if e <> 0 then Exit;
if Addr = 0
then AResult := 'nil'
else begin
S := GetInstanceClassName(Addr);
if S = '' then S := '???';
AResult := S + ' ' + AResult;
end; end;
end; end;
finally
ResultInfo.Free;
end; end;
finally finally
ResultInfo.Free; if frameidx <> frame
then begin
// Restore current frame
ExecuteCommand('-stack-select-frame %u', [frame], [cfIgnoreError]);
end;
end; end;
end; end;