diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index b53c21c07c..098a9bf4b2 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/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); @@ -725,11 +736,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; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 3053d233a1..f24583ba79 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/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; diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index 4a4329b074..0218911180 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/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; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 892e1dcf96..7bf0a21401 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/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]);