* variants are now stored in a stream as regular values instead of as a

    secific variant type
  + support for storing qwords in streams (vaQWord, necessary for varQWord
    support)
  * moved variant serialisation from twriter into tbinaryobjectwriter so
    it can be overridden
   (all further changes for mantis #10482)

git-svn-id: trunk@12820 -

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, vaVariant);
+    vaUTF8String, vaUString, vaQWord);
 
   TFilerFlag = (ffInherited, ffChildPos, ffInline);
   TFilerFlags = set of TFilerFlag;
@@ -1174,6 +1174,8 @@ type
     procedure WriteCurrency(const Value: Currency); virtual; abstract;
     procedure WriteIdent(const Ident: string); virtual; abstract;
     procedure WriteInteger(Value: Int64); virtual; abstract;
+    procedure WriteUInt64(Value: QWord); virtual; abstract;
+    procedure WriteVariant(const Value: tvardata); virtual; abstract;
     procedure WriteMethodName(const Name: String); virtual; abstract;
     procedure WriteSet(Value: LongInt; SetType: Pointer); virtual; abstract;
     procedure WriteString(const Value: String); virtual; abstract;
@@ -1225,11 +1227,13 @@ type
     procedure WriteCurrency(const Value: Currency); override;
     procedure WriteIdent(const Ident: string); override;
     procedure WriteInteger(Value: Int64); override;
+    procedure WriteUInt64(Value: QWord); override;
     procedure WriteMethodName(const Name: String); override;
     procedure WriteSet(Value: LongInt; SetType: Pointer); override;
     procedure WriteString(const Value: String); override;
     procedure WriteWideString(const Value: WideString); override;
     procedure WriteUnicodeString(const Value: UnicodeString); override;
+    procedure WriteVariant(const VarValue: tvardata);override;
   end;
 
   TTextObjectWriter = class(TAbstractObjectWriter)

rtl/objpas/classes/reader.inc

@@ -1076,76 +1076,88 @@ begin
 end;
 
 function TReader.ReadVariant: tvardata;
-type
-  tcurrec = record
-    i: int64;
-  end;
+var
+  nv: TValueType;
 begin
   { Ensure that a Variant manager is installed }
   if not Assigned(VarClearProc) then
     raise EReadError.Create(SErrNoVariantSupport);
 
   FillChar(Result,sizeof(Result),0);
-  Read(Result.vtype,sizeof(Result.vtype));
 
-  case Result.vtype of
-    varEmpty,
-    varNull:
-      ;
+  nv:=NextValue;
+  case nv of
+    vaNil:
+      begin
+        Result.vtype:=varEmpty;
+      end;
+    vaNull:
+      begin
+        Result.vtype:=varNull;
+      end;
     { all integer sizes must be split for big endian systems }
-    varShortInt:
+    vaInt8:
       begin
+        Result.vtype:=varShortInt;
         Result.vShortInt:=ReadInteger;
       end;
-    varSmallInt:
+    vaInt16:
       begin
+        Result.vtype:=varSmallInt;
         Result.vSmallInt:=ReadInteger;
       end;
-    varInteger:
+    vaInt32:
       begin
+        Result.vtype:=varInteger;
         Result.vInteger:=ReadInteger;
       end;
-    varInt64,varQWord:
+    vaInt64:
+      begin
+        Result.vtype:=varInt64;
+        Result.vInt64:=ReadInt64;
+      end;
+    vaQWord:
       begin
+        Result.vtype:=varQWord;
         Result.vInt64:=ReadInt64;
       end;
-    varBoolean:
+    vaFalse,vaTrue:
       begin
-        Result.vBoolean:=ReadBoolean;
+        Result.vtype:=varBoolean;
+        Result.vBoolean:=(nv<>vaFalse);
       end;
-    varCurrency:
+    vaCurrency:
       begin
-        { avoid implicit value conversion by the compiler }
-        Result.vCurrency:=Currency(tcurrec(ReadInt64));
+        Result.vtype:=varCurrency;
+        Result.vCurrency:=ReadCurrency;
       end;
 {$ifndef fpunone}
-    varSingle:
+    vaSingle:
       begin
+        Result.vtype:=varSingle;
         Result.vSingle:=ReadSingle;
       end;
-    varDouble:
+    vaExtended:
       begin
+        Result.vtype:=varDouble;
         Result.vDouble:=ReadFloat;
       end;
-    varDate:
+    vaDate:
       begin
-        Result.vDate:=ReadFloat;
+        Result.vtype:=varDate;
+        Result.vDate:=ReadDate;
       end;
 {$endif fpunone}
-    varOlestr:
+    vaWString,vaUString,vaUTF8String:
       begin
+        Result.vtype:=varOlestr;
         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;

rtl/objpas/classes/writer.inc

@@ -252,6 +252,36 @@ begin
   end;
 end;
 
+procedure TBinaryObjectWriter.WriteUInt64(Value: QWord);
+var
+  s: ShortInt;
+  i: SmallInt;
+  l: Longint;
+begin
+  { Use the smallest possible integer type for the given value: }
+  if (Value <= 127) then
+  begin
+    WriteValue(vaInt8);
+    s := Value;
+    Write(s, 1);
+  end else if (Value <= 32767) then
+  begin
+    WriteValue(vaInt16);
+    i := Value;
+    WriteWord(word(i));
+  end else if (Value <= $7fffffff) then
+  begin
+    WriteValue(vaInt32);
+    l := Value;
+    WriteDWord(longword(l));
+  end else
+  begin
+    WriteValue(vaQWord);
+    WriteQWord(Value);
+  end;
+end;
+
+
 procedure TBinaryObjectWriter.WriteMethodName(const Name: String);
 begin
   if Length(Name) > 0 then
@@ -343,6 +373,74 @@ begin
   end;
 end;
 
+procedure TBinaryObjectWriter.WriteVariant(const VarValue: tvardata);
+begin
+  case VarValue.vtype of
+    varEmpty:
+      begin
+        WriteValue(vaNil);
+      end;
+    varNull:
+      begin
+        WriteValue(vaNull);
+      end;
+    { 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:
+      begin
+        WriteInteger(VarValue.vint64);
+      end;
+    varQWord:
+      begin
+        WriteUInt64(qword(VarValue.vint64));
+      end;
+    varBoolean:
+      begin
+        WriteBoolean(VarValue.vboolean);
+      end;
+    varCurrency:
+      begin
+        WriteCurrency(VarValue.vcurrency);
+      end;
+{$ifndef fpunone}
+    varSingle:
+      begin
+        WriteSingle(VarValue.vsingle);
+      end;
+    varDouble:
+      begin
+        WriteFloat(VarValue.vdouble);
+      end;
+    varDate:
+      begin
+        WriteDate(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 TBinaryObjectWriter.FlushBuffer;
 begin
   FStream.WriteBuffer(FBuffer^, FBufPos);
@@ -721,72 +819,8 @@ begin
 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;
+  Driver.WriteVariant(VarValue);
 end;
 
 procedure TWriter.WriteListBegin;