paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 18:39:10 +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 var
s: String; s: String;
begin begin
ATypeName := '';
Result := ADbgSymbol <> nil; Result := ADbgSymbol <> nil;
if not Result then if not Result then
exit; exit;
@ -228,7 +229,8 @@ var
exit; exit;
end; end;
Result := MembersAsGdbText(s, True, [tdfSkipClassBody]); Result := MembersAsGdbText(s, True, [tdfSkipClassBody]);
GetTypeName(s2, ADbgSymbol.TypeInfo); if not GetTypeName(s2, ADbgSymbol.TypeInfo) then
s2 := '';
if Result then if Result then
ADeclaration := Format('class(%s)%s%s%send', ADeclaration := Format('class(%s)%s%s%send',
[s2, LineEnding, s, GetIndent]); [s2, LineEnding, s, GetIndent]);

26
components/fpdebug/fppascalparser.pas
View File

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

51
debugger/fpgdbmidebugger.pp
View File

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