diff --git a/.gitattributes b/.gitattributes
index 1d8993f072..69bd4a29e6 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -8607,6 +8607,7 @@ tests/webtbs/tw10425.pp svneol=native#text/plain
tests/webtbs/tw1044.pp svneol=native#text/plain
tests/webtbs/tw10454.pp svneol=native#text/plain
tests/webtbs/tw1046.pp svneol=native#text/plain
+tests/webtbs/tw10482.pp svneol=native#text/plain
tests/webtbs/tw10489.pp svneol=native#text/plain
tests/webtbs/tw10492.pp svneol=native#text/plain
tests/webtbs/tw10493.pp svneol=native#text/plain
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 1e79a88528..1b9d59e4b0 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -902,7 +902,7 @@ type
TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64,
- vaUTF8String, vaUString);
+ vaUTF8String, vaUString, vaVariant);
TFilerFlag = (ffInherited, ffChildPos, ffInline);
TFilerFlags = set of TFilerFlag;
@@ -1123,6 +1123,7 @@ type
procedure ReadListBegin;
procedure ReadListEnd;
function ReadRootComponent(ARoot: TComponent): TComponent;
+ function ReadVariant: tvardata;
function ReadString: string;
function ReadWideString: WideString;
function ReadUnicodeString: UnicodeString;
@@ -1299,6 +1300,7 @@ type
procedure WriteString(const Value: string);
procedure WriteWideString(const Value: WideString);
procedure WriteUnicodeString(const Value: UnicodeString);
+ procedure WriteVariant(const VarValue: tvardata);
property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
diff --git a/rtl/objpas/classes/reader.inc b/rtl/objpas/classes/reader.inc
index b5e705ee3a..d62dc64f6f 100644
--- a/rtl/objpas/classes/reader.inc
+++ b/rtl/objpas/classes/reader.inc
@@ -307,10 +307,10 @@ var
i: Integer;
begin
case StringType of
- vaLString,vaUTF8String:
- i:=ReadDWord;
- else
- //vaString:
+ vaLString, vaUTF8String:
+ i:=ReadDWord;
+ else
+ //vaString:
begin
Read(b, 1);
i := b;
@@ -1075,6 +1075,76 @@ begin
CheckValue(vaNull);
end;
+function TReader.ReadVariant: tvardata;
+type
+ tcurrec = record
+ i: int64;
+ end;
+begin
+ if not Assigned(VarClearProc) then
+ raise EReadError.Create(SErrNoVariantSupport);
+
+ VarClearProc(Result);
+ Read(Result.vtype,sizeof(Result.vtype));
+
+ case Result.vtype of
+ varEmpty,
+ varNull:
+ ;
+ { all integer sizes must be split for big endian systems }
+ varShortInt:
+ begin
+ Result.vShortInt:=ReadInteger;
+ end;
+ varSmallInt:
+ begin
+ Result.vSmallInt:=ReadInteger;
+ end;
+ varInteger:
+ begin
+ Result.vInteger:=ReadInteger;
+ end;
+ varInt64,varQWord:
+ begin
+ Result.vInt64:=ReadInt64;
+ end;
+ varBoolean:
+ begin
+ Result.vBoolean:=ReadBoolean;
+ end;
+ varCurrency:
+ begin
+ { avoid implicit value conversion by the compiler }
+ Result.vCurrency:=Currency(tcurrec(ReadInt64));
+ end;
+{$ifndef fpunone}
+ varSingle:
+ begin
+ Result.vSingle:=ReadSingle;
+ end;
+ varDouble:
+ begin
+ Result.vDouble:=ReadFloat;
+ end;
+ varDate:
+ begin
+ Result.vDate:=ReadFloat;
+ end;
+{$endif fpunone}
+ varOlestr:
+ begin
+ WideString(Pointer(Result.volestr)):=ReadWideString;
+ end;
+ varString:
+ begin
+ Ansistring(Result.vstring):=ReadWideString;
+ end;
+ else
+ raise EReadError.CreateFmt(SUnsupportedPropertyVariantType, [Ord(Result.vtype)]);
+ end;
+end;
+
+
procedure TReader.ReadProperty(AInstance: TPersistent);
var
Path: String;
@@ -1191,6 +1261,7 @@ var
Method: TMethod;
Handled: Boolean;
TmpStr: String;
+ VarTemp: tvardata;
begin
if not Assigned(PPropInfo(PropInfo)^.SetProc) then
raise EReadError.Create(SReadOnlyProperty);
@@ -1260,7 +1331,12 @@ begin
SetUnicodeStrProp(Instance,PropInfo,ReadUnicodeString);
tkWString:
SetWideStrProp(Instance,PropInfo,ReadWideString);
- {!!!: tkVariant}
+ tkVariant:
+ begin
+ { can't use variant() typecast, pulls in variant unit }
+ VarTemp:=ReadVariant;
+ SetVariantProp(Instance,PropInfo,PVariant(@VarTemp)^);
+ end;
tkClass:
case FDriver.NextValue of
vaNil:
@@ -1400,9 +1476,9 @@ begin
StringType := FDriver.ReadValue;
if StringType in [vaString, vaLString,vaUTF8String] then
begin
- Result := FDriver.ReadString(StringType);
- if (StringType=vaUTF8String) then
- Result:=utf8Decode(Result);
+ Result := FDriver.ReadString(StringType);
+ if (StringType=vaUTF8String) then
+ Result:=utf8Decode(Result);
end
else if StringType in [vaWString] then
Result:= FDriver.ReadWidestring
diff --git a/rtl/objpas/classes/writer.inc b/rtl/objpas/classes/writer.inc
index 7aad4ec33d..99bb12d86e 100644
--- a/rtl/objpas/classes/writer.inc
+++ b/rtl/objpas/classes/writer.inc
@@ -720,6 +720,75 @@ begin
Driver.WriteInteger(Value);
end;
+procedure TWriter.WriteVariant(const VarValue: tvardata);
+type
+ tcurrec = record
+ i: int64;
+ end;
+var
+ vtype: tvartype;
+begin
+ vtype:=VarValue.vtype;
+ Write(ord(vtype),sizeof(vtype));
+ case vtype of
+ varEmpty,
+ varNull:
+ ;
+ { all integer sizes must be split for big endian systems }
+ varShortInt:
+ begin
+ WriteInteger(VarValue.vshortint);
+ end;
+ varSmallInt:
+ begin
+ WriteInteger(VarValue.vsmallint);
+ end;
+ varInteger:
+ begin
+ WriteInteger(VarValue.vinteger);
+ end;
+ varInt64,varQWord:
+ begin
+ WriteInteger(int64(VarValue.vint64));
+ end;
+ varBoolean:
+ begin
+ WriteBoolean(VarValue.vboolean);
+ end;
+ varCurrency:
+ begin
+ { write as int64, because on non-x86 a floating point register does
+ not have enough precision to hold the entire range of currency
+ }
+ WriteInteger(tcurrec(VarValue.vcurrency).i);
+ end;
+{$ifndef fpunone}
+ varSingle:
+ begin
+ WriteSingle(VarValue.vsingle);
+ end;
+ varDouble:
+ begin
+ WriteFloat(VarValue.vdouble);
+ end;
+ varDate:
+ begin
+ WriteFloat(VarValue.vdate);
+ end;
+{$endif fpunone}
+ varOleStr:
+ begin
+ WriteWideString(widestring(pointer(VarValue.volestr)));
+ end;
+ varString:
+ begin
+ WriteWideString(AnsiString(VarValue.vstring));
+ end;
+ else
+ raise EWriteError.CreateFmt(SUnsupportedPropertyVariantType, [Ord(VarValue.vtype)]);
+ end;
+end;
+
procedure TWriter.WriteListBegin;
begin
Driver.BeginList;
@@ -746,6 +815,7 @@ begin
Instance.DefineProperties(Self);
end;
+
procedure TWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
var
HasAncestor: Boolean;
@@ -767,6 +837,7 @@ var
SavedAncestor: TPersistent;
SavedPropPath, Name: String;
Int64Value, DefInt64Value: Int64;
+ VarValue, DefVarValue : tvardata;
BoolValue, DefBoolValue: boolean;
Handled: Boolean;
@@ -918,7 +989,24 @@ begin
Driver.EndProperty;
end;
end;
- {!!!: tkVariant:}
+ tkVariant:
+ begin
+ if not assigned(VarClearProc) then
+ raise EWriteError.Create(SErrNoVariantSupport);
+
+ VarValue := tvardata(GetVariantProp(Instance, PropInfo));
+ if HasAncestor then
+ DefVarValue := tvardata(GetVariantProp(Ancestor, PropInfo))
+ else
+ VarClearProc(DefVarValue);
+
+ if (CompareByte(VarValue,DefVarValue,sizeof(VarValue)) <> 0) then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteVariant(VarValue);
+ Driver.EndProperty;
+ end;
+ end;
tkClass:
begin
ObjValue := TObject(GetObjectProp(Instance, PropInfo));
diff --git a/tests/webtbs/tw10482.pp b/tests/webtbs/tw10482.pp
new file mode 100644
index 0000000000..790ac850e5
--- /dev/null
+++ b/tests/webtbs/tw10482.pp
@@ -0,0 +1,100 @@
+program fpctest4;
+{$ifdef fpc}
+{$mode delphi}
+{$endif fpc}
+uses
+{$ifdef unix}
+ cwstring,
+{$endif}
+ Classes,sysutils,variants,typinfo;
+
+type
+ TTestClass=class(TComponent)
+ private
+ fV1,fV2,fV3:variant;
+ procedure SetV2(const v:variant);
+ published
+ property V1:Variant read fV1 write fV1;
+ property V2:Variant read fV2 write SetV2;
+ property V3:Variant read fV3 write fV3;
+ end;
+
+const
+ {$ifdef fpc}
+ ws:WideString=#$43f#$440#$438#$432#$435#$442', '#$43f#$440#$44B#$432#$456#$442#$430#$43d#$44c#$43d#$435' - pr'#$fc'fung spa'#$df' gut';
+ {$else}
+ ws:WideString='ÔË‚ÂÚ, Ô˚‚≥ڇ̸Ì - prufung spa'#$df' gut';
+ {$endif}
+
+procedure TTestClass.SetV2(const v:variant);
+begin
+ fV2:=v;
+ writeln('Set V2');
+end;
+
+var tc:TTestClass;
+ f:TStream;
+ vv:variant;
+ ff : TFileStream;
+begin
+
+ RegisterClasses([TTestClass]);
+
+
+ tc:=TTestClass.Create(nil);
+ tc.v1:=123.45;
+ tc.v2:='Hello world';
+ tc.v3:=ws;
+
+ vv:=GetVariantProp(tc,'V2');
+ if vv<>Null then
+ begin
+ if (vv<>'Hello world') then
+ halt(1);
+ writeln('got=',vv);
+ end
+ else
+ halt(2);
+
+
+ SetVariantProp(tc,'V1',333.333);
+
+ vv:=GetVariantProp(tc,'V1');
+ if vv<>Null then
+ begin
+ if (vv<>333.333) then
+ halt(3);
+ writeln('got=',vv);
+ end
+ else
+ halt(4);
+
+ f:=TMemoryStream.Create;
+ f.WriteComponent(tc); // store it
+
+ ff:=TFileStream.Create('tw19482.str',fmCreate);
+ ff.WriteComponent(tc); // store it
+ ff.Free;
+
+ tc.Free; // kill it
+
+ f.free;
+
+ f:=TFileStream.Create('tw19482.str',fmOpenRead);
+
+ tc:=TTestClass(f.ReadComponent(nil));
+
+ writeln('v1=',tc.v1);
+ writeln('v2=',tc.v2);
+ writeln('v3=',tc.v3);
+ if (tc.v1<>333.333) then
+ halt(5);
+ if (tc.v2<>'Hello world') then
+ halt(6);
+ if (tc.v3<>ws) then
+ halt(7);
+
+ f.Free;
+
+ DeleteFile('tw19482.str')
+end.