FpDebug: Check char-size for strings. Recognize "UnicodeString", Issue #35340

git-svn-id: branches/fixes_2_0@60938 -

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -122,7 +122,7 @@ type
 
   TFpDwarfV3FreePascalSymbolTypeArray = class(TFpDwarfFreePascalSymbolTypeArray)
   private type
-    TArrayOrStringType = (iasUnknown, iasArray, iasShortString, iasAnsiString);
+    TArrayOrStringType = (iasUnknown, iasArray, iasShortString, iasAnsiString, iasUnicodeString);
   private
     FArrayOrStringType: TArrayOrStringType;
     function GetInternalStringType: TArrayOrStringType;
@@ -588,6 +588,7 @@ function TFpDwarfV3FreePascalSymbolTypeArray.GetInternalStringType: TArrayOrStri
 var
   Info: TDwarfInformationEntry;
   t: Cardinal;
+  t2: TFpDbgSymbol;
 begin
   Result := FArrayOrStringType;
   if Result <> iasUnknown then
@@ -599,6 +600,10 @@ begin
   Info := InformationEntry.FirstChild;
   if Info = nil then exit;
 
+  t2 := TypeInfo;
+  if (t2 = nil) or (t2.Kind <> skChar) then
+    exit;
+
   while Info.HasValidScope do begin
     t := Info.AbbrevTag;
     if (t = DW_TAG_enumeration_type) then
@@ -610,7 +615,10 @@ begin
       // This is a string
       // TODO: check the location parser, if it is a reference
       //FIsShortString := iasShortString;
-      FArrayOrStringType := iasAnsiString;
+      if (t2.Size = 2) then
+        FArrayOrStringType := iasUnicodeString
+      else
+        FArrayOrStringType := iasAnsiString;
       Result := FArrayOrStringType;
       break;
     end;
@@ -623,7 +631,7 @@ end;
 function TFpDwarfV3FreePascalSymbolTypeArray.GetTypedValueObject(
   ATypeCast: Boolean): TFpDwarfValue;
 begin
-  if GetInternalStringType in [iasShortString, iasAnsiString] then
+  if GetInternalStringType in [iasShortString, iasAnsiString, iasUnicodeString] then
     Result := TFpDwarfV3ValueFreePascalString.Create(Self)
   else
     Result := inherited GetTypedValueObject(ATypeCast);
@@ -636,6 +644,8 @@ begin
       SetKind(skString);
     iasAnsiString:
       SetKind(skString); // TODO
+    iasUnicodeString:
+      SetKind(skWideString);
     else
       inherited KindNeeded;
   end;
@@ -651,7 +661,7 @@ begin
   If not Result then
     exit;
 
-  assert(TypeCastTargetType.Kind = skString, 'TFpDwarfValueArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray');
+  assert(TypeCastTargetType.Kind in [skString, skWideString], 'TFpDwarfValueArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray');
 
   f := TypeCastSourceValue.FieldFlags;
   if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
@@ -695,6 +705,7 @@ var
   t, t2: TFpDbgSymbol;
   LowBound, HighBound: Int64;
   Addr: TFpDbgMemLocation;
+  WResult: UnicodeString;
 begin
   if FValueDone then
     exit(FValue);
@@ -727,11 +738,21 @@ begin
   if HighBound - LowBound > 5000 then
     HighBound := LowBound + 5000;
 
-  SetLength(Result, HighBound-LowBound+1);
+  if t.Kind = skWideString then begin
+    SetLength(WResult, HighBound-LowBound+1);
 
-  if not MemManager.ReadMemory(Addr, HighBound-LowBound+1, @Result[1]) then begin
-    Result := '';
-    FLastError := MemManager.LastError;
+    if not MemManager.ReadMemory(Addr, (HighBound-LowBound+1)*2, @WResult[1]) then begin
+      WResult := '';
+      FLastError := MemManager.LastError;
+    end;
+    Result := WResult;
+  end else begin
+    SetLength(Result, HighBound-LowBound+1);
+
+    if not MemManager.ReadMemory(Addr, HighBound-LowBound+1, @Result[1]) then begin
+      Result := '';
+      FLastError := MemManager.LastError;
+    end;
   end;
 
   FValue := Result;

components/fpdebug/fpdbginfo.pas

@@ -256,6 +256,21 @@ type
     constructor Create(AValue: AnsiString);
   end;
 
+  { TFpDbgValueConstWideChar }
+
+  TFpDbgValueConstWideChar = class(TFpDbgValue) // skChar / Not for strings
+  private
+    FValue: String;
+    FSigned: Boolean;
+  protected
+    property Value: String read FValue write FValue;
+    function GetKind: TDbgSymbolKind; override;
+    function GetFieldFlags: TFpDbgValueFieldFlags; override;
+    function GetAsString: AnsiString; override;
+  public
+    constructor Create(AValue: AnsiString);
+  end;
+
   { TFpDbgValueConstFloat }
 
   TFpDbgValueConstFloat = class(TFpDbgValue)
@@ -538,6 +553,29 @@ begin
   FValue := AValue;
 end;
 
+{ TFpDbgValueConstWideChar }
+
+function TFpDbgValueConstWideChar.GetKind: TDbgSymbolKind;
+begin
+  Result := skChar;
+end;
+
+function TFpDbgValueConstWideChar.GetFieldFlags: TFpDbgValueFieldFlags;
+begin
+  Result := [svfString]
+end;
+
+function TFpDbgValueConstWideChar.GetAsString: AnsiString;
+begin
+  Result := Value;
+end;
+
+constructor TFpDbgValueConstWideChar.Create(AValue: AnsiString);
+begin
+  inherited Create;
+  FValue := AValue;
+end;
+
 { TFpDbgCircularRefCountedObject }
 
 procedure TFpDbgCircularRefCountedObject.DoPlainReferenceAdded;

components/fpdebug/fppascalbuilder.pas

@@ -711,6 +711,15 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
     Result := True;
   end;
 
+  procedure DoWideString;
+  begin
+    APrintedValue := QuoteText(AValue.AsString);
+    if (ppvCreateDbgType in AFlags) then begin
+      ADBGTypeInfo^ := TDBGType.Create(skWideString, ResTypeName);
+    end;
+    Result := True;
+  end;
+
   procedure DoFloat;
   begin
     APrintedValue := FloatToStr(AValue.AsFloat);
@@ -1011,7 +1020,7 @@ begin
     skAnsiString: ;
     skCurrency: ;
     skVariant: ;
-    skWideString: ;
+    skWideString: DoWideString;
     skEnum:      DoEnum;
     skEnumValue: DoEnumVal;
     skSet:       DoSet;

components/fpdebug/fppascalparser.pas

@@ -1026,6 +1026,7 @@ var
   ti: TFpDbgSymbol;
   IsPChar: Boolean;
   v: String;
+  w: WideString;
 begin
   Result := nil;
   assert(Count >= 2, 'TFpPascalExpressionPartBracketIndex.DoGetResultValue: Count >= 2');
@@ -1112,7 +1113,31 @@ begin
           end;
 
           TmpVal2 := TFpDbgValueConstChar.Create(v[Offs]);
-        end
+        end;
+      skWideString: begin
+          //TODO: move to FpDwarfValue.member ??
+          if (svfInteger in TmpIndex.FieldFlags) then
+            Offs := TmpIndex.AsInteger
+          else
+          if (svfOrdinal in TmpIndex.FieldFlags) and (TmpIndex.AsCardinal <= high(Int64))
+          then
+            Offs := Int64(TmpIndex.AsCardinal)
+          else
+          begin
+            SetError('Can not calculate Index');
+            TmpVal.ReleaseReference;
+            exit;
+          end;
+
+          w := TmpVal.AsWideString;
+          if (Offs < 1) or (Offs > Length(w)) then begin
+            SetError('Index out of range');
+            TmpVal.ReleaseReference;
+            exit;
+          end;
+
+          TmpVal2 := TFpDbgValueConstChar.Create(w[Offs]);
+        end;
       else
         begin
           SetError(fpErrTypeHasNoIndex, [GetText]);