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

FPDebug: starting error msgs

Browse Source 
git-svn-id: trunk@44196 -
This commit is contained in:
martin 2014-02-21 07:52:15 +00:00
parent 7e70fbf99b
commit da31678f3b
6 changed files with 223 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1270,6 +1270,7 @@ components/fpdebug/fpdbgwinextra.pp svneol=native#text/pascal
components/fpdebug/fpdebug.lpk svneol=native#text/pascal
components/fpdebug/fpdebug.pas svneol=native#text/pascal
components/fpdebug/fpdmemorytools.pas svneol=native#text/pascal
components/fpdebug/fperrormessages.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderbase.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderelf.pas svneol=native#text/pascal
components/fpdebug/fpimgreaderelftypes.pas svneol=native#text/pascal

6
components/fpdebug/fpdebug.lpk
View File

@ -34,7 +34,7 @@ File(s) with other licenses (see also header in file(s):
(Any modifications/translations of this file are from duby)
"/>
<Files Count="21">
<Files Count="22">
<Item1>
<Filename Value="fpdbgclasses.pp"/>
<UnitName Value="FpDbgClasses"/>
@ -120,6 +120,10 @@ File(s) with other licenses (see also header in file(s):
<Filename Value="fpdmemorytools.pas"/>
<UnitName Value="FpdMemoryTools"/>
</Item21>
<Item22>
<Filename Value="fperrormessages.pas"/>
<UnitName Value="fperrormessages"/>
</Item22>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">

3
components/fpdebug/fpdebug.pas
View File

@ -10,7 +10,8 @@ uses
FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, FpDbgPETypes,
FpDbgSymbols, FpDbgUtil, FpDbgWinExtra, FpImgReaderWinPE, FpImgReaderElf,
FpImgReaderElfTypes, FpImgReaderBase, FpPascalParser, macho, FpImgReaderMachoFile,
FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, FpdMemoryTools, LazarusPackageIntf;
FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
LazarusPackageIntf;
implementation

162
components/fpdebug/fperrormessages.pas Normal file
View File

@ -0,0 +1,162 @@
unit FpErrorMessages;
{$mode objfpc}{$H+}
interface
uses
SysUtils, LazLoggerBase;
type
TFpErrorCode = Integer;
resourcestring
// %0:s is always linebreak
MsgfpErrAnyError = '%1:s';
MsgfpErrSymbolNotFound = 'Identifier not found: "%1:s"';
MsgfpErrNoMemberWithName = 'Member not found: %1:s';
const
fpErrAnyError = TFpErrorCode(1);
fpErrSymbolNotFound = TFpErrorCode(2);
fpErrNoMemberWithName = TFpErrorCode(3);
type
TFpError = record
ErrorCode: TFpErrorCode;
ErrorData: Array of TVarRec;
ErrorData2: Array of String;
end;
{ TErrorHandler }
{ TFpErrorHandler }
TFpErrorHandler = class
protected
function GetErrorRawString(AnErrorCode: TFpErrorCode): string;
public
function CreateError(AnErrorCode: TFpErrorCode; AData: array of const): TFpError;
function CreateError(AnErrorCode: TFpErrorCode; AnError: TFpError; AData: array of const): TFpError;
function ErrorAsString(AnError: TFpError): string;
function ErrorAsString(AnErrorCode: TFpErrorCode; AData: array of const): string;
end;
function GetFpErrorHandler: TFpErrorHandler;
procedure SetFpErrorHandler(AHandler: TFpErrorHandler);
property FpErrorHandler: TFpErrorHandler read GetFpErrorHandler write SetFpErrorHandler;
function IsFpError(AnError: TFpError): Boolean;
function FpErrorNone: TFpError;
implementation
var TheErrorHandler: TFpErrorHandler = nil;
function GetFpErrorHandler: TFpErrorHandler;
begin
if TheErrorHandler = nil then
TheErrorHandler := TFpErrorHandler.Create;
Result := TheErrorHandler;
end;
procedure SetFpErrorHandler(AHandler: TFpErrorHandler);
begin
FreeAndNil(TheErrorHandler);
TheErrorHandler := AHandler;
end;
function IsFpError(AnError: TFpError): Boolean;
begin
Result := AnError.ErrorCode <> 0;
end;
function FpErrorNone: TFpError;
begin
Result.ErrorCode := 0;
end;
{ TFpErrorHandler }
function TFpErrorHandler.GetErrorRawString(AnErrorCode: TFpErrorCode): string;
begin
case AnErrorCode of
fpErrAnyError: Result := MsgfpErrAnyError;
fpErrSymbolNotFound: Result := MsgfpErrSymbolNotFound;
fpErrNoMemberWithName: Result := MsgfpErrNoMemberWithName;
end;
end;
function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode;
AData: array of const): TFpError;
var
i: Integer;
begin
Result.ErrorCode := AnErrorCode;
SetLength(Result.ErrorData, Length(AData));
SetLength(Result.ErrorData2, Length(AData));
for i := low(AData) to high(AData) do begin
Result.ErrorData[i] := AData[i];
if AData[i].VType = vtAnsiString then begin
Result.ErrorData2[i] := AnsiString(AData[i].VAnsiString);
Result.ErrorData[i].VAnsiString := Pointer(Result.ErrorData2[i]);
end;
end;
end;
function TFpErrorHandler.CreateError(AnErrorCode: TFpErrorCode; AnError: TFpError;
AData: array of const): TFpError;
var
i, j: Integer;
begin
Result.ErrorCode := AnErrorCode;
j := Length(AnError.ErrorData);
SetLength(Result.ErrorData, Length(AData) + j);
SetLength(Result.ErrorData2, Length(AData) + j);
for i := 0 to j - 1 do begin
Result.ErrorData2[i] := AnError.ErrorData2[i];
Result.ErrorData[i] := AnError.ErrorData[i];
end;
for i := low(AData) to high(AData) do begin
Result.ErrorData[j+i] := AData[i];
if AData[i].VType = vtAnsiString then begin
Result.ErrorData2[j+i] := AnsiString(AData[i].VAnsiString);
Result.ErrorData[j+i].VAnsiString := Pointer(Result.ErrorData2[j+i]);
end;
end;
end;
function TFpErrorHandler.ErrorAsString(AnError: TFpError): string;
var
RealData: Array of TVarRec;
i: Integer;
begin
Result := ErrorAsString(AnError.ErrorCode, AnError.ErrorData);
end;
function TFpErrorHandler.ErrorAsString(AnErrorCode: TFpErrorCode;
AData: array of const): string;
var
RealData: Array of TVarRec;
i: Integer;
s: String;
begin
Result := '';
if AnErrorCode = 0 then exit;
SetLength(RealData, Length(AData) + 1);
s := LineEnding;
RealData[0].VAnsiString := Pointer(s); // first arg is always line end
for i := 0 to Length(AData) - 1 do
RealData[i + 1] := AData[i];
s := GetErrorRawString(AnErrorCode);
if s = '' then s := 'Internal Error: ' + IntToStr(AnErrorCode);
Result := Format(s, RealData);
end;
finalization
FreeAndNil(TheErrorHandler);
end.

50
components/fpdebug/fppascalparser.pas
View File

@ -29,7 +29,8 @@ unit FpPascalParser;
interface
uses
Classes, sysutils, math, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazClasses;
Classes, sysutils, math, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
LazLoggerBase, LazClasses;
type
@ -46,14 +47,15 @@ type
TFpPascalExpression = class
private
FError: String;
FError: TFpError;
FContext: TDbgInfoAddressContext;
FTextExpression: String;
FExpressionPart: TFpPascalExpressionPart;
FValid: Boolean;
function GetResultValue: TDbgSymbolValue;
procedure Parse;
procedure SetError(AMsg: String);
procedure SetError(AMsg: String); // deprecated;
procedure SetError(AnErrorCode: TFpErrorCode; AData: array of const);
function PosFromPChar(APChar: PChar): Integer;
protected
function GetDbgSymbolForIdentifier({%H-}AnIdent: String): TDbgSymbol;
@ -63,7 +65,7 @@ type
constructor Create(ATextExpression: String; AContext: TDbgInfoAddressContext);
destructor Destroy; override;
function DebugDump(AWithResults: Boolean = False): String;
property Error: String read FError;
property Error: TFpError read FError;
property Valid: Boolean read FValid;
// ResultValue
// - May be a type, if expression is a type
@ -88,8 +90,9 @@ type
procedure SetEndChar(AValue: PChar);
procedure SetParent(AValue: TFpPascalExpressionPartContainer);
procedure SetStartChar(AValue: PChar);
procedure SetError(AMsg: String = '');
procedure SetError(APart: TFpPascalExpressionPart; AMsg: String = '');
procedure SetError(AMsg: String = ''); // deprecated;
procedure SetError(APart: TFpPascalExpressionPart; AMsg: String = ''); // deprecated;
procedure SetError(AnErrorCode: TFpErrorCode; AData: array of const);
protected
function DebugText(AIndent: String; {%H-}AWithResults: Boolean): String; virtual; // Self desc only
function DebugDump(AIndent: String; AWithResults: Boolean): String; virtual;
@ -1149,8 +1152,10 @@ var
begin
Result := nil;
DbgSymbol := FExpression.GetDbgSymbolForIdentifier(GetText);
if DbgSymbol = nil then
if DbgSymbol = nil then begin
SetError(fpErrSymbolNotFound, [GetText]);
exit;
end;
Result := DbgSymbol.Value;
if Result = nil then begin
@ -1352,11 +1357,21 @@ end;
procedure TFpPascalExpression.SetError(AMsg: String);
begin
FValid := False;
FError := AMsg;
if FError.ErrorCode <> 0 then begin
DebugLn(['Skipping error ', AMsg]);
FValid := False;
exit;
end;
SetError(fpErrAnyError, [AMsg]);
DebugLn(['PARSER ERROR ', AMsg]);
end;
procedure TFpPascalExpression.SetError(AnErrorCode: TFpErrorCode; AData: array of const);
begin
FValid := False;
FError := FpErrorHandler.CreateError(AnErrorCode, AData);
end;
function TFpPascalExpression.PosFromPChar(APChar: PChar): Integer;
begin
Result := APChar - @FTextExpression[1] + 1;
@ -1375,6 +1390,7 @@ constructor TFpPascalExpression.Create(ATextExpression: String;
begin
FContext := AContext;
FTextExpression := ATextExpression;
FError := FpErrorNone;
FValid := True;
Parse;
end;
@ -1388,7 +1404,7 @@ end;
function TFpPascalExpression.DebugDump(AWithResults: Boolean): String;
begin
Result := 'TFpPascalExpression: ' + FTextExpression + LineEnding +
'Valid: ' + dbgs(FValid) + ' Error: "' + FError + '"'+ LineEnding
'Valid: ' + dbgs(FValid) + ' Error: "' + dbgs(FError.ErrorCode) + '"'+ LineEnding
;
if FExpressionPart <> nil then
Result := Result + FExpressionPart.DebugDump(' ', AWithResults);
@ -1476,6 +1492,11 @@ begin
else Self.SetError(AMsg);
end;
procedure TFpPascalExpressionPart.SetError(AnErrorCode: TFpErrorCode; AData: array of const);
begin
FExpression.SetError(AnErrorCode, AData);
end;
procedure TFpPascalExpressionPart.Init;
begin
//
@ -2051,9 +2072,12 @@ begin
// Todo unit
if (tmp.Kind in [skClass, skRecord, skObject]) then begin
Result := tmp.MemberByName[Items[1].GetText];
if Result <> nil then
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
Assert((Result=nil) or (Result.DbgSymbol=nil)or(Result.DbgSymbol.SymbolType=stValue), 'member is value');
if Result = nil then begin
SetError(fpErrNoMemberWithName, [Items[1].GetText]);
exit;
end;
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
Assert((Result.DbgSymbol=nil)or(Result.DbgSymbol.SymbolType=stValue), 'member is value');
end;
end;

17
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -15,7 +15,7 @@ uses
Classes, sysutils, math, FpdMemoryTools, FpDbgInfo, FpDbgClasses, GDBMIDebugger,
DbgIntfBaseTypes, DbgIntfDebuggerBase, GDBMIMiscClasses,
GDBTypeInfo, maps, LCLProc, Forms, FpDbgLoader, FpDbgDwarf, FpDbgDwarfConst, LazLoggerBase,
LazLoggerProfiling, LazClasses, FpPascalParser, FpPascalBuilder;
LazLoggerProfiling, LazClasses, FpPascalParser, FpPascalBuilder, FpErrorMessages;
type
@ -1454,6 +1454,21 @@ begin
PasExpr := TFpPascalExpression.Create(AExpression, Ctx);
try
if not IsWatchValueAlive then exit;
PasExpr.ResultValue; // trigger evaluate // and check errors
if not IsWatchValueAlive then exit;
if not PasExpr.Valid then begin
DebugLn(FpErrorHandler.ErrorAsString(PasExpr.Error));
if PasExpr.Error.ErrorCode <> fpErrAnyError then begin
Result := True;
AResText := FpErrorHandler.ErrorAsString(PasExpr.Error);;
if AWatchValue <> nil then begin;
AWatchValue.Value := AResText;
AWatchValue.Validity := ddsError;
end;
exit;
end;
end;
if not (PasExpr.Valid and (PasExpr.ResultValue <> nil)) then
exit; // TODO handle error