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

FPDebug: fixes

Browse Source 
git-svn-id: trunk@43379 -
This commit is contained in:
martin 2013-11-06 01:11:41 +00:00
parent 6123660445
commit 6be8179494
3 changed files with 60 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpdebug/fppascalbuilder.pas
View File

@ -38,6 +38,7 @@ function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol;
var
s: String;
begin
ATypeName := '';
Result := ADbgSymbol <> nil;
if not Result then
exit;
@ -228,7 +229,8 @@ var
exit;
end;
Result := MembersAsGdbText(s, True, [tdfSkipClassBody]);
GetTypeName(s2, ADbgSymbol.TypeInfo);
if not GetTypeName(s2, ADbgSymbol.TypeInfo) then
s2 := '';
if Result then
ADeclaration := Format('class(%s)%s%s%send',
[s2, LineEnding, s, GetIndent]);

26
components/fpdebug/fppascalparser.pas
View File

@ -79,7 +79,7 @@ type
FResultTypeFlag: (rtUnknown, rtType, rtTypeCast);
function GetResultType: TDbgSymbol;
function GetResultTypeCast: TDbgSymbol;
function GetSurroundingBracket: TFpPascalExpressionPartBracket;
function GetSurroundingOpenBracket: TFpPascalExpressionPartBracket;
function GetTopParent: TFpPascalExpressionPart;
procedure SetEndChar(AValue: PChar);
procedure SetParent(AValue: TFpPascalExpressionPartContainer);
@ -117,7 +117,7 @@ type
property EndChar: PChar read FEndChar write SetEndChar;
property Parent: TFpPascalExpressionPartContainer read FParent write SetParent;
property TopParent: TFpPascalExpressionPart read GetTopParent; // or self
property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingBracket; // incl self
property SurroundingBracket: TFpPascalExpressionPartBracket read GetSurroundingOpenBracket; // incl self
property ResultType: TDbgSymbol read GetResultType;
property ResultTypeCast: TDbgSymbol read GetResultTypeCast;
end;
@ -470,6 +470,17 @@ begin
end;
Result := TPasParserSymbolArrayDeIndex.Create(tmp);
end
else
if (tmp.Kind = skPointer) then begin
Result := tmp.TypeInfo;
Result.AddReference;
exit;
end
else
if (tmp.Kind = skString) then begin
//TODO
exit;
end;
end;
@ -879,6 +890,7 @@ procedure TFpPascalExpression.SetError(AMsg: String);
begin
FValid := False;
FError := AMsg;
DebugLn(['PARSER ERROR ', AMsg]);
end;
function TFpPascalExpression.PosFromPChar(APChar: PChar): Integer;
@ -928,13 +940,15 @@ begin
Result := Result.Parent;
end;
function TFpPascalExpressionPart.GetSurroundingBracket: TFpPascalExpressionPartBracket;
function TFpPascalExpressionPart.GetSurroundingOpenBracket: TFpPascalExpressionPartBracket;
var
tmp: TFpPascalExpressionPart;
begin
Result := nil;
tmp := Self;
while (tmp <> nil) and not(tmp is TFpPascalExpressionPartBracket) do
while (tmp <> nil) and
( not(tmp is TFpPascalExpressionPartBracket) or ((tmp as TFpPascalExpressionPartBracket).IsClosed) )
do
tmp := tmp.Parent;
if tmp <> nil then
Result := TFpPascalExpressionPartBracket(tmp);
@ -1416,7 +1430,9 @@ begin
Result := (inherited IsValidNextPart(APart))
else
Result := (inherited IsValidNextPart(APart)) and
(APart is TFpPascalExpressionPartIdentifer);
( (APart is TFpPascalExpressionPartIdentifer) or
(APart is TFpPascalExpressionPartOperatorMakeRef)
);
end;
function TFpPascalExpressionPartOperatorMakeRef.DoGetResultType: TDbgSymbol;

51
debugger/fpgdbmidebugger.pp
View File

@ -142,6 +142,12 @@ begin
inherited Create;
end;
type
TFpPascalExpressionHack = class(TFpPascalExpression)
public
property ExpressionPart;
end;
function TFpGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
ARequest: TGDBPTypeRequest): Integer;
const
@ -338,15 +344,20 @@ const
s, ParentName, RefToken: String;
s2: String;
begin
if (ABaseType.TypeInfo = nil) then
exit;
if APointerLevel = 0 then
ADeRefTypeName := ASrcTypeName;
ParentName := ABaseType.TypeInfo.Name;
if not MembersAsGdbText(ABaseType, True, s2) then
exit;
s := Format('type = ^%s = class : public %s %s%send%s', [ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
if (ABaseType.TypeInfo <> nil) then begin
ParentName := ABaseType.TypeInfo.Name;
if ParentName <> '' then
ParentName := ' public ' + ParentName;
end
else
ParentName := '';
s := Format('type = ^%s = class :%s %s%send%s', [ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
s := Format('type = %s%s', [ASrcTypeName, LineEnding]);
@ -357,7 +368,7 @@ const
if APointerLevel > 0
then RefToken := '^'
else RefToken := '';
s := Format('type = %s%s = class : public %s %s%send%s', [RefToken, ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
s := Format('type = %s%s = class :%s %s%send%s', [RefToken, ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
s := Format('type = %s%s', [ADeRefTypeName, LineEnding]);
@ -559,6 +570,7 @@ const
var
IdentName: String;
PasExpr: TFpGDBMIPascalExpression;
rt: TDbgSymbol;
begin
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
DebugLn(['######## '+ARequest.Request, ' ## FOUND: ', dbgs(Result)]);
@ -569,18 +581,27 @@ DebugLn(['######## '+ARequest.Request, ' ## FOUND: ', dbgs(Result)]);
FInIndexOf := True;
PasExpr := nil;
try
if ARequest.ReqType = gcrtPType then begin
if (ARequest.ReqType = gcrtPType) and (length(ARequest.Request) > 0) then begin
//DebugLn('######## '+ARequest.Request);
if copy(ARequest.Request, 1, 6) = 'ptype ' then
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)))
else
if copy(ARequest.Request, 1, 7) = 'whatis ' then
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
case ARequest.Request[1] of
'p': if copy(ARequest.Request, 1, 6) = 'ptype ' then
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)));
'w': if copy(ARequest.Request, 1, 7) = 'whatis ' then
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
end;
PasExpr := TFpGDBMIPascalExpression.Create(IdentName, FDebugger, AThreadId, AStackFrame);
AddType(IdentName, PasExpr.ResultType);
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
if IdentName <> '' then begin
PasExpr := TFpGDBMIPascalExpression.Create(IdentName, FDebugger, AThreadId, AStackFrame);
if PasExpr.Valid then begin
rt := PasExpr.ResultType;
if (rt = nil) and (TFpPascalExpressionHack(PasExpr).ExpressionPart <> nil) then
rt := TFpPascalExpressionHack(PasExpr).ExpressionPart.ResultTypeCast;
if rt <> nil then begin
AddType(IdentName, rt);
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
end;
end;
end;
end;
finally