FPDebug: starting error msgs

git-svn-id: trunk@44196 -

.gitattributes

@@ -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

components/fpdebug/fpdebug.lpk

@@ -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">

components/fpdebug/fpdebug.pas

@@ -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
 

components/fpdebug/fperrormessages.pas

@@ -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.
+

components/fpdebug/fppascalparser.pas

@@ -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(AMsg: String = ''); // deprecated;
-    procedure SetError(APart: TFpPascalExpressionPart; AMsg: String = '');
+    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
+  if FError.ErrorCode <> 0 then begin
+DebugLn(['Skipping error ', AMsg]);
     FValid := False;
-  FError := AMsg;
+    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
+    if Result = nil then begin
+      SetError(fpErrNoMemberWithName, [Items[1].GetText]);
+      exit;
+    end;
     Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
-    Assert((Result=nil) or (Result.DbgSymbol=nil)or(Result.DbgSymbol.SymbolType=stValue), 'member is value');
+    Assert((Result.DbgSymbol=nil)or(Result.DbgSymbol.SymbolType=stValue), 'member is value');
   end;
 end;
 

components/lazdebuggerfp/fpgdbmidebugger.pp

@@ -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