FpDebug: Read embedded type for enum signed-ness (fpc 3.3.1). Add other checks for enum signed-ness

components/fpdebug/fpdbgdwarf.pas

@@ -568,6 +568,8 @@ type
   TFpDwarfAtEntryDataReadState = (rfNotRead, rfNotFound, rfError, rfConst, rfValue, rfExpression);
   PFpDwarfAtEntryDataReadState = ^TFpDwarfAtEntryDataReadState;
 
+  TFpDwarfSignInfo = (sgnUnknown, sgnNotAvail, sgnUnsigned, sgnSigned);
+
   { TFpSymbolDwarf }
 
   TFpSymbolDwarf = class(TDbgDwarfSymbolBase)
@@ -577,6 +579,7 @@ type
     function GetNestedTypeInfo: TFpSymbolDwarfType;
     function GetTypeInfo: TFpSymbolDwarfType; inline;
   protected
+    function  GetSignInfo: TFpDwarfSignInfo; virtual;
     function  DoGetNestedTypeInfo: TFpSymbolDwarfType; virtual;
     function  ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean;
     function  IsArtificial: Boolean; // usud by formal param and subprogram
@@ -888,8 +891,12 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
   { TFpSymbolDwarfDataEnumMember }
 
   TFpSymbolDwarfDataEnumMember  = class(TFpSymbolDwarfData)
+    FSigned: TFpDwarfSignInfo;
     FOrdinalValue: Int64;
     FOrdinalValueRead, FHasOrdinalValue: Boolean;
+    FCardinalValue: QWord;
+    FCardinalValueRead, FHasCardinalValue: Boolean;
+    function ReadCardinalValue(out AValue: QWord): Boolean;
     procedure ReadOrdinalValue;
   protected
     procedure KindNeeded; override;
@@ -905,8 +912,11 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
   TFpSymbolDwarfTypeEnum = class(TFpSymbolDwarfType)
   private
     FMembers: TRefCntObjList;
+    FSigned: TFpDwarfSignInfo;
+    FNstSymForSigned: TFpSymbolDwarf;
     procedure CreateMembers;
   protected
+    function GetSignInfo: TFpDwarfSignInfo; override;
     procedure KindNeeded; override;
     function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
     function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
@@ -2998,10 +3008,11 @@ end;
 
 procedure TFpValueDwarfEnum.InitMemberIndex;
 var
-  MbrVal: QWord;
+  MbrVal, NstVal: QWord;
-  i, j: Integer;
+  i: Integer;
   Sz: TFpDbgValueSize;
   Mask: TDBGPtr;
+  nst: TFpSymbol;
 begin
   // TODO: if TypeInfo is a subrange, check against the bounds, then bypass it, and scan all members (avoid subrange scanning members)
   if FMemberValueDone then exit;
@@ -3013,10 +3024,19 @@ begin
   MbrVal := GetAsCardinal and Mask;
 
   i := FTypeSymbol.NestedSymbolCount - 1;
-  j := -1;
   while i >= 0 do begin
-    if (QWord(FTypeSymbol.NestedSymbol[i].OrdinalValue) and Mask) = MbrVal then
+    nst := FTypeSymbol.NestedSymbol[i];
+    if nst is TFpSymbolDwarfDataEnumMember then begin
+      if TFpSymbolDwarfDataEnumMember(nst).ReadCardinalValue(NstVal) and
+         ((NstVal and Mask) = MbrVal)
+      then
         break;
+    end
+    else begin
+      assert(False, 'TFpValueDwarfEnum.InitMemberIndex: False');
+      if nst.HasOrdinalValue and ((QWord(nst.OrdinalValue) and Mask) = MbrVal) then
+        break;
+    end;
     dec(i);
   end;
   FMemberIndex := i;
@@ -3047,10 +3067,27 @@ begin
 
   if (not GetSize(Size)) or (Size <= 0) or (Size > SizeOf(Result)) then
     Result := inherited GetAsCardinal
-  else
+  else begin
+    case TFpSymbolDwarf(FTypeSymbol).GetSignInfo of
+      sgnUnknown, sgnNotAvail: begin
           if not Context.ReadEnum(OrdOrDataAddr, Size, Result) then begin
             SetLastError(Context.LastMemError);
-    Result := 0; // TODO: error
+            Result := 0;
+          end
+          else
+            Result := QWord(SignExtend(Result, Size));
+        end;
+      sgnUnsigned:
+        if not Context.ReadUnsignedInt(OrdOrDataAddr, Size, Result) then begin
+          SetLastError(Context.LastMemError);
+          Result := 0;
+        end;
+      sgnSigned:
+        if not Context.ReadSignedInt(OrdOrDataAddr, Size, int64(Result)) then begin
+          SetLastError(Context.LastMemError);
+          Result := 0;
+        end;
+    end;
   end;
 
   FValue := Result;
@@ -3060,9 +3097,7 @@ function TFpValueDwarfEnum.GetAsInteger: Int64;
 var
   Size: TFpDbgValueSize;
 begin
-  Result := GetAsCardinal;
+  Result := Int64(GetAsCardinal);
-  if GetSize(Size) then
-    Result := SignExtend(QWord(Result), Size);
 end;
 
 procedure TFpValueDwarfEnum.SetAsCardinal(AValue: QWord);
@@ -4422,6 +4457,17 @@ begin
   Result := TFpSymbolDwarfType(inherited TypeInfo);
 end;
 
+function TFpSymbolDwarf.GetSignInfo: TFpDwarfSignInfo;
+var
+  n: TFpSymbolDwarfType;
+begin
+  n := NestedTypeInfo;
+  if (n <> nil) then
+    Result := n.GetSignInfo
+  else
+    Result := sgnNotAvail;
+end;
+
 function TFpSymbolDwarf.DoGetNestedTypeInfo: TFpSymbolDwarfType;
 var
   FwdInfoPtr: Pointer;
@@ -5940,11 +5986,62 @@ end;
 
 { TDbgDwarfIdentifierEnumElement }
 
-procedure TFpSymbolDwarfDataEnumMember.ReadOrdinalValue;
+function TFpSymbolDwarfDataEnumMember.ReadCardinalValue(out AValue: QWord): Boolean;
 begin
-  if FOrdinalValueRead then exit;
+  AValue := FCardinalValue;
+  Result := FHasCardinalValue;
+  if FCardinalValueRead then
+    exit;
+
+  FCardinalValueRead := True;
+  FHasCardinalValue := InformationEntry.ReadValue(DW_AT_const_value, FCardinalValue);
+  AValue := FCardinalValue;
+  Result := FHasCardinalValue;
+end;
+
+procedure TFpSymbolDwarfDataEnumMember.ReadOrdinalValue;
+  function GetSignInfo: TFpDwarfSignInfo;
+  var
+    ParentInfo: TDwarfInformationEntry;
+    ParentSym: TFpSymbolDwarf;
+  begin
+    Result := FSigned;
+    if FSigned <> sgnUnknown then
+      exit;
+    ParentInfo := InformationEntry.Clone;
+    ParentInfo.GoParent;
+    ParentSym := TFpSymbolDwarf.CreateSubClass('', ParentInfo);
+    ParentInfo.ReleaseReference;
+    if ParentSym is TFpSymbolDwarfTypeEnum then
+      TFpSymbolDwarfTypeEnum(ParentSym).FNstSymForSigned := Self; // don't create a new member
+
+    Result := ParentSym.GetSignInfo;
+    FSigned := Result;
+
+    ParentSym.ReleaseReference;
+  end;
+var
+  AttrData: TDwarfAttribData;
+begin
+  if FOrdinalValueRead then
+    exit;
+
   FOrdinalValueRead := True;
-  FHasOrdinalValue := InformationEntry.ReadValue(DW_AT_const_value, FOrdinalValue);
+  FHasOrdinalValue := ReadCardinalValue(QWord(FOrdinalValue));
+
+  if FHasOrdinalValue and
+     InformationEntry.GetAttribData(DW_AT_const_value, AttrData) and
+     (AttrData.InformationEntry <> nil)
+  then begin
+    case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
+      DW_FORM_data1: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
+        FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(1));
+      DW_FORM_data2: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
+        FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(2));
+      DW_FORM_data4: if GetSignInfo in [sgnUnknown, sgnNotAvail, sgnSigned] then
+        FOrdinalValue := SignExtend(QWord(FOrdinalValue), SizeVal(4));
+    end;
+  end;
 end;
 
 procedure TFpSymbolDwarfDataEnumMember.KindNeeded;
@@ -5993,6 +6090,8 @@ begin
     if (Info.AbbrevTag = DW_TAG_enumerator) then begin
       Info2 := Info.Clone;
       sym := TFpSymbolDwarf.CreateSubClass('', Info2);
+      if sym is TFpSymbolDwarfDataEnumMember then
+        TFpSymbolDwarfDataEnumMember(sym).FSigned := FSigned;
       FMembers.Add(sym);
       sym.ReleaseReference;
       Info2.ReleaseReference;
@@ -6003,6 +6102,154 @@ begin
   Info.ReleaseReference;
 end;
 
+function TFpSymbolDwarfTypeEnum.GetSignInfo: TFpDwarfSignInfo;
+var
+  NstType: TFpSymbolDwarfType;
+  InfoEntry: TDwarfInformationEntry;
+  AttrData: TDwarfAttribData;
+  NstSym: TFpSymbolDwarf;
+  Sz: TFpDbgValueSize;
+  MaybeUnsigned: Boolean;
+  Encoding, i, c: Integer;
+  NstVal, SgnMask: QWord;
+  sym: TFpSymbol;
+begin
+  Result := FSigned;
+  if FSigned <> sgnUnknown then
+    exit;
+
+  try
+    FSigned := sgnNotAvail;
+    NstType := NestedTypeInfo;
+    if NstType <> nil then begin
+      case NstType.Kind of
+        skInteger:  FSigned := sgnSigned;
+        skCardinal: FSigned := sgnUnsigned;
+      end;
+      Result := FSigned;
+      if FSigned <> sgnNotAvail then
+        exit;
+    end;
+
+    // GCC writes DW_AT_encoding - even thought it is not allowed here
+    if InformationEntry.ReadValue(DW_AT_encoding, Encoding) then begin
+      debugln(FPDBG_DWARF_VERBOSE, ['TFpSymbolDwarfTypeEnum.InitSigned found DW_AT_encoding']);
+      case Encoding of
+        DW_ATE_signed,   DW_ATE_signed_char:   FSigned := sgnSigned;
+        DW_ATE_unsigned, DW_ATE_unsigned_char: FSigned := sgnUnsigned;
+      end;
+      Result := FSigned;
+      if FSigned <> sgnNotAvail then
+        exit;
+    end;
+
+    // Guess from member data
+    if (FNstSymForSigned <> nil) then begin
+      InfoEntry := FNstSymForSigned.InformationEntry;
+      if (InfoEntry <> nil) and
+         InfoEntry.GetAttribData(DW_AT_const_value, AttrData) and
+         (AttrData.InformationEntry <> nil)
+      then begin
+        case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
+          DW_FORM_sdata: FSigned := sgnSigned; // may be unsigned (llvm), but the enum-member will not sign extend it
+          DW_FORM_udata: FSigned := sgnUnsigned;
+        end;
+      end;
+      Result := FSigned;
+      if FSigned <> sgnNotAvail then
+        exit;
+    end;
+
+    if (FNstSymForSigned <> nil) or (NestedSymbolCount > 0) then begin
+      if ReadSize(nil, Sz) and (not IsZeroSize(Sz)) then begin
+        MaybeUnsigned := True;
+        SgnMask := SignMask(Sz);
+        c := 0;
+        if FNstSymForSigned = nil then
+          c := NestedSymbolCount - 1;
+        for i := 0 to c do begin
+          NstSym := FNstSymForSigned;
+          if NstSym = nil then
+            NstSym := TFpSymbolDwarf(NestedSymbol[i]);
+          if (NstSym <> nil) then begin
+            InfoEntry := NstSym.InformationEntry;
+            if (InfoEntry <> nil) and
+               InfoEntry.GetAttribData(DW_AT_const_value, AttrData) and
+               (AttrData.InformationEntry <> nil)
+            then begin
+              case AttrData.InformationEntry.AttribForm[AttrData.Idx] of
+                DW_FORM_sdata: begin
+                    if TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) then begin
+                      if Int64(NstVal) < 0 then
+                        FSigned := sgnSigned
+                      else
+                      if (NstVal and SgnMask) <> 0 then
+                        FSigned := sgnUnsigned;  // positive value that was not sign extended
+                    end;
+                  end;
+                DW_FORM_udata: FSigned := sgnUnsigned;
+                // If the form is bigger than the size, then use the lead as sign info
+                DW_FORM_data2:
+                  if (SizeToFullBytes(Sz) < 2) then begin
+                    if (NstSym is TFpSymbolDwarfDataEnumMember) and
+                       TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
+                       (NstVal and QWord($8000) <> 0)
+                    then
+                      FSigned := sgnSigned;
+                  end
+                  else
+                    MaybeUnsigned := False;
+                DW_FORM_data4:
+                  if (SizeToFullBytes(Sz) < 4) then begin
+                    if (NstSym is TFpSymbolDwarfDataEnumMember) and
+                       TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
+                       (NstVal and QWord($80000000) <> 0)
+                    then
+                      FSigned := sgnSigned;
+                  end
+                  else
+                    MaybeUnsigned := False;
+                DW_FORM_data8:
+                  if (SizeToFullBytes(Sz) < 8) then begin
+                    if (NstSym is TFpSymbolDwarfDataEnumMember) and
+                       TFpSymbolDwarfDataEnumMember(NstSym).ReadCardinalValue(NstVal) and
+                       (NstVal and QWord($8000000000000000) <> 0)
+                    then
+                      FSigned := sgnSigned;
+                  end
+                  else
+                    MaybeUnsigned := False;
+                otherwise begin
+                    MaybeUnsigned := False;
+                    break;
+                  end;
+              end;
+            end;
+          end;
+
+          Result := FSigned;
+          if FSigned <> sgnNotAvail then
+            exit;
+          if (not MaybeUnsigned) then
+            break;
+        end;
+      end;
+      if MaybeUnsigned and (FSigned = sgnNotAvail) then begin
+        FSigned := sgnUnsigned;
+        Result := FSigned;
+      end;
+    end;
+  finally
+    if (FMembers <> nil) and (FNstSymForSigned = nil) then begin
+      for i := 0 to FMembers.Count - 1 do begin
+        sym := TFpSymbol(FMembers[i]);
+        if sym is TFpSymbolDwarfDataEnumMember then
+          TFpSymbolDwarfDataEnumMember(sym).FSigned := FSigned;
+      end;
+    end;
+  end;
+end;
+
 function TFpSymbolDwarfTypeEnum.GetTypedValueObject(ATypeCast: Boolean;
   AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
 begin

components/fpdebug/fpdmemorytools.pas

@@ -613,6 +613,7 @@ function LocToAddrOrNil(const ALocation: TFpDbgMemLocation): TDbgPtr; inline; //
 
 function SignExtend(ASrcVal: QWord; ASrcSize: TFpDbgValueSize): Int64;
 function BitMask(ASize: TFpDbgValueSize): QWord; inline;
+function SignMask(ASize: TFpDbgValueSize): QWord; inline;
 
 //function EmptyMemReadOpts:TFpDbgMemReadOptions;
 
@@ -1027,6 +1028,16 @@ begin
     Result := Result shr (64 - i);
 end;
 
+function SignMask(ASize: TFpDbgValueSize): QWord;
+var
+  i: Int64;
+begin
+  Result := 0;
+  i := SizeToBits(ASize) - 1;
+  if (i >= 0) and (i < 64) then
+    Result := QWord(1) shl i;
+end;
+
 //function {%H-}EmptyMemReadOpts: TFpDbgMemReadOptions;
 //begin
 //  //