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: arrays

Browse Source 
git-svn-id: trunk@43354 -
This commit is contained in:
martin 2013-11-03 01:28:04 +00:00
parent 7fd984012b
commit de89e7cd72
3 changed files with 178 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpdebug/fpdbgdwarf.pas
View File

@ -1862,7 +1862,9 @@ var
begin
Result := False;
ti := NestedTypeInfo; // Same as TypeInfo, but does not try to be forwarded
Result := (ti <> nil) and (ti.Kind = skArray) and (sfDynArray in ti.Flags);
Result := (ti <> nil) and (ti is TDbgDwarfIdentifierArray);
if Result then
Result := (sfDynArray in ti.Flags);
end;
function TDbgDwarfTypeIdentifierPointer.GetIsInternalPointer: Boolean;
@ -2330,7 +2332,7 @@ begin
Result := lst[h].Entry = FInformationEntry;
if Result then
ScopeIndex := h;
debugln(['TDwarfInformationEntry.SearchScope ', h]);
//debugln(['TDwarfInformationEntry.SearchScope ', h]);
end;
function TDwarfInformationEntry.MaybeSearchScope: Boolean;

79
components/fpdebug/fppascalbuilder.pas
View File

@ -17,8 +17,13 @@ type
TTypeNameFlags = set of TTypeNameFlag;
TTypeDeclarationFlag = (
tdfIncludeVarName, // like i: Integer
tdfSkipClassBody // shorten class
tdfNoFirstLineIndent,
tdfIncludeVarName, // like i: Integer
tdfSkipClassBody, // shorten class
tdfSkipRecordBody, // shorten class
tdfDynArrayWithPointer, // TODO, temp, act like gdb
tdfStopAfterPointer
);
TTypeDeclarationFlags = set of TTypeDeclarationFlag;
@ -128,7 +133,7 @@ var
while (i < c) and Result do begin
m := ADbgSymbol.Member[i];
AddVisibility(m.MemberVisibility, i= 0);
Result := GetTypeAsDeclaration(s, m, [tdfIncludeVarName] + AFlags, AnIndent + 4);
Result := GetTypeAsDeclaration(s, m, [tdfNoFirstLineIndent, tdfIncludeVarName] + AFlags, AnIndent + 4);
if Result then
AText := AText + GetIndent + s + ';' + LineEnding;
inc(i);
@ -144,7 +149,16 @@ var
ADbgSymbol := ADbgSymbol.TypeInfo;
s := s + '^';
end;
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
if not(tdfStopAfterPointer in AFlags) then begin
Result := GetTypeAsDeclaration(ADeclaration, ADbgSymbol, AFlags);
if not Result then
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
end
else begin
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
if not Result then
Result := GetTypeAsDeclaration(ADeclaration, ADbgSymbol, AFlags);
end;
if NeedBracket(ADeclaration)
then ADeclaration := s + '(' + ADeclaration + ')'
else ADeclaration := s + ADeclaration;
@ -188,7 +202,7 @@ var
s: String;
begin
// Todo param
GetTypeAsDeclaration(s, ADbgSymbol.TypeInfo);
GetTypeAsDeclaration(s, ADbgSymbol.TypeInfo, AFlags);
ADeclaration := 'function ' + ADbgSymbol.Name + ' () : ' + s + '';
if sfVirtual in ADbgSymbol.Flags then ADeclaration := ADeclaration + '; virtual';
Result := true;
@ -215,17 +229,22 @@ var
Result := MembersAsGdbText(s, True, [tdfSkipClassBody]);
GetTypeName(s2, ADbgSymbol.TypeInfo);
if Result then
ADeclaration := Format('class(%s)%s%s%send%s',
[s2, LineEnding, s, LineEnding, GetIndent]);
ADeclaration := Format('class(%s)%s%s%send',
[s2, LineEnding, s, GetIndent]);
end;
function GetRecordType(out ADeclaration: String): Boolean;
var
s: String;
begin
Result := MembersAsGdbText(s, True);
if tdfSkipRecordBody in AFlags then begin
GetTypeName(s, ADbgSymbol);
ADeclaration := s + ' {=record}';
exit;
end;
Result := MembersAsGdbText(s, False);
if Result then
ADeclaration := Format('record%s%s%send%s', [LineEnding, s, LineEnding, GetIndent]);
ADeclaration := Format('record%s%s%send', [LineEnding, s, GetIndent]);
end;
function GetEnumType(out ADeclaration: String): Boolean;
@ -279,7 +298,7 @@ var
s := t.Name;
end
else
Result := GetTypeAsDeclaration(s, t);
Result := GetTypeAsDeclaration(s, t, AFlags);
ADeclaration := 'set of ' + s;
end;
else
@ -287,6 +306,43 @@ var
end;
end;
function GetArrayType(out ADeclaration: String): Boolean;
var
t: TDbgSymbol;
s: String;
i: Integer;
begin
// TODO assigned value (a,b:=3,...)
t := ADbgSymbol.TypeInfo;
Result := (t <> nil);
if not Result then exit;
s := t.Name;
if s = '' then begin
Result := GetTypeAsDeclaration(s, t, [tdfNoFirstLineIndent, tdfStopAfterPointer] + AFlags, AnIndent + 4); // no class ?
if not Result then exit;
end;
if sfDynArray in ADbgSymbol.Flags then begin //supprts only one level
ADeclaration := 'array of ' + s;
if tdfDynArrayWithPointer in AFlags then
ADeclaration := '^(' + ADeclaration + ')';
end
else begin
ADeclaration := 'array [';
for i := 0 to ADbgSymbol.MemberCount - 1 do begin
if i > 0 then
ADeclaration := ADeclaration + ', ';
t := ADbgSymbol.Member[i];
if t.Kind = skCardinal
then ADeclaration := ADeclaration + Format('%u..%u', [QWord(t.OrdLowBound), QWord(t.OrdHighBound)])
else ADeclaration := ADeclaration + Format('%d..%d', [t.OrdLowBound, t.OrdHighBound]);
end;
ADeclaration := ADeclaration + '] of ' + s;
end;
end;
var
VarName: String;
begin
@ -315,11 +371,12 @@ begin
skRecord: Result := GetRecordType(ATypeDeclaration);
skEnum: Result := GetEnumType(ATypeDeclaration);
skset: Result := GetSetType(ATypeDeclaration);
skArray: Result := GetArrayType(ATypeDeclaration);
end;
if VarName <> '' then
ATypeDeclaration := VarName + ': ' + ATypeDeclaration;
if AnIndent <> 0 then
if (AnIndent <> 0) and not(tdfNoFirstLineIndent in AFlags) then
ATypeDeclaration := GetIndent + ATypeDeclaration;
end;

159
debugger/fpgdbmidebugger.pp
View File

@ -148,6 +148,8 @@ const
GdbCmdPType = 'ptype ';
GdbCmdWhatIs = 'whatis ';
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgSymbol); forward;
procedure FindPointerAndBaseType(ASrcType: TDbgSymbol;
out APointerLevel: Integer; out ADeRefType, ABaseType: TDbgSymbol;
out ASrcTypeName, ADeRefTypeName, ABaseTypeName: String);
@ -217,6 +219,13 @@ const
end;
s := ti.Name;
if s = '' then begin
if (AMember.Kind = FpDbgClasses.skSet) or (AMember.Kind = FpDbgClasses.skEnum) or
(AMember.Kind = FpDbgClasses.skArray)
then
if not GetTypeAsDeclaration(s, ti, [tdfSkipClassBody, tdfSkipRecordBody]) then
s := '';
end;
if (s = '') and not (AMember.Kind = FpDbgClasses.skRecord) then begin
Result := False;
exit;
end;
@ -267,7 +276,7 @@ const
if inherited IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
AReq.Result := ParseTypeFromGdb(AAnswer);
Add(AThreadId, AStackFrame, AReq);
debugln(['TFpGDBMIDebugger.AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >> ', AAnswer]);
debugln(['**** AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >>>> ', AAnswer, ' <<<<']);
end;
end;
@ -331,7 +340,7 @@ const
begin
if (ABaseType.TypeInfo = nil) then
exit;
if APointerLevel > 0 then
if APointerLevel = 0 then
ADeRefTypeName := ASrcTypeName;
ParentName := ABaseType.TypeInfo.Name;
if not MembersAsGdbText(ABaseType, True, s2) then
@ -415,6 +424,95 @@ const
end;
end;
procedure AddArrayType(ASourceExpr: string; APointerLevel: Integer;
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
ASrcType, ABaseType: TDbgSymbol);
var
s, s2: String;
ElemPointerLevel: Integer;
ElemDeRefType, ElemBaseType: TDbgSymbol;
ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName: String;
begin
if sfDynArray in ABaseType.Flags then begin
// dyn
if ABaseType.TypeInfo = nil then exit;
FindPointerAndBaseType(ABaseType.TypeInfo, ElemPointerLevel,
ElemDeRefType, ElemBaseType,
ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName);
s := ElemSrcTypeName;
if (s = '') then begin
if not GetTypeAsDeclaration(s, ABaseType.TypeInfo, [tdfDynArrayWithPointer]) then
exit;
s := Format('type = %s%s', [StringOfChar('^', APointerLevel), s]);
end
else
s := Format('type = %s%s', ['^', s]); // ElemSrcTypeName already has ^, if it is pointer
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s + LineEnding);
s := ASrcTypeName;
if (s = '') then begin
if not GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then
exit;
s := Format('type = %s%s', [StringOfChar('^', APointerLevel), s]);
end
else
s := Format('type = %s', [s]);
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s + LineEnding);
// deref
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
if APointerLevel = 0 then begin
if not GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then
exit;
if s[1] = '^' then begin
Delete(s,1,1);
if (s <> '') and (s[1] = '(') and (s[Length(s)] = ')') then begin
Delete(s,Length(s),1);
Delete(s,1,1);
end;
end;
s := Format('type = %s%s', [s, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
AddType(ASourceExpr+'[0]', ABaseType.TypeInfo);
end
else begin
s := ElemSrcTypeName;
if (s = '') then begin
if not GetTypeAsDeclaration(s, ABaseType.TypeInfo, [tdfDynArrayWithPointer]) then
exit;
s := Format('type = %s%s', [StringOfChar('^', APointerLevel-1), s]);
end
else
s := Format('type = ^%s', [s]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s + LineEnding);
end;
end
else begin
// stat
if GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then begin
s := Format('type = %s%s', [s, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
if ASrcTypeName <> ''
then MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ASrcTypeName)
else MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
end;
if APointerLevel = 0 then exit;
ASrcType := ASrcType.TypeInfo;
if GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then begin
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
s := Format('type = %s%s', [s, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
if ASrcTypeName <> ''
then MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ADeRefTypeName)
else MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
end;
end;
end;
procedure AddType(ASourceExpr: string; ATypeIdent: TDbgSymbol);
var
SrcTypeName, // The expressions own type name
@ -450,58 +548,12 @@ const
AddSetType(ASourceExpr, PointerLevel,
SrcTypeName, DeRefTypeName, BaseTypeName,
ATypeIdent, BaseType);
FpDbgClasses.skArray:
AddArrayType(ASourceExpr, PointerLevel,
SrcTypeName, DeRefTypeName, BaseTypeName,
ATypeIdent, BaseType);
end;
(*
IsPointerType := ATypeIdent.Kind = FpDbgClasses.skPointer;
IsPointerPointer := False;
SrcTypeName := ATypeIdent.Name;
SrcType := ATypeIdent;
if IsPointerType and (ATypeIdent.TypeInfo <> nil) then begin
ATypeIdent := ATypeIdent.TypeInfo;
if ATypeIdent = nil then exit;
// resolved 1st pointer
if SrcTypeName = '' then
SrcTypeName := '^'+ATypeIdent.Name;
IsPointerPointer := ATypeIdent.Kind = FpDbgClasses.skPointer;
DeRefTypeName := ATypeIdent.Name;
while (ATypeIdent.Kind = FpDbgClasses.skPointer) and (ATypeIdent.TypeInfo <> nil) do begin
ATypeIdent := ATypeIdent.TypeInfo;
if SrcTypeName = '' then SrcTypeName := '^'+ATypeIdent.Name;
if DeRefTypeName = '' then DeRefTypeName := '^'+ATypeIdent.Name;
end;
if ATypeIdent = nil then exit;
end;
BaseTypeName := ATypeIdent.Name;
DebugLn(['--------------'+dbgs(ATypeIdent.Kind), ' ', dbgs(IsPointerType)]);
if ATypeIdent.Kind in [skInteger, skCardinal, skBoolean, skChar, skFloat]
then begin
AddBaseType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
end
else
if ATypeIdent.Kind in [FpDbgClasses.skClass]
then begin
AddClassType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
end
else
if ATypeIdent.Kind in [FpDbgClasses.skRecord]
then begin
AddRecordType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
end
else
if ATypeIdent.Kind in [FpDbgClasses.skEnum]
then begin
AddEnumType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName,
SrcTypeName, DeRefTypeName, SrcType, ATypeIdent);
end;
*)
end;
var
@ -509,6 +561,7 @@ var
PasExpr: TFpGDBMIPascalExpression;
begin
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
DebugLn(['######## '+ARequest.Request, ' ## FOUND: ', dbgs(Result)]);
if (Result >= 0) or FInIndexOf then
exit;
@ -517,7 +570,7 @@ begin
PasExpr := nil;
try
if ARequest.ReqType = gcrtPType then begin
DebugLn('############### '+ARequest.Request);
//DebugLn('######## '+ARequest.Request);
if copy(ARequest.Request, 1, 6) = 'ptype ' then
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)))
else