Commit 6d1944a6 authored by Martin's avatar Martin
Browse files

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

git-svn-id: trunk@60930 -
parent 3b3bbd67
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
......@@ -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]);
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment