From 423ca16d1381abddf9595c690f4966964619360d Mon Sep 17 00:00:00 2001 From: inoussa Date: Wed, 17 Jun 2009 19:03:05 +0000 Subject: [PATCH] Better handling of "LowgWord" and "QWord" in the serializers. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@852 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_binary_formatter.pas | 77 ++++++++++-- wst/trunk/base_json_formatter.pas | 119 +++++++++++++++++- wst/trunk/base_soap_formatter.pas | 111 ++++++++++++---- wst/trunk/base_xmlrpc_formatter.pas | 107 ++++++++++++---- .../tests/test_suite/testformatter_unit.pas | 14 ++- wst/trunk/wst_global.inc | 2 + 6 files changed, 364 insertions(+), 66 deletions(-) diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index 5b12b2bfe..d7f5d9471 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -285,6 +285,13 @@ type Const ATypeInfo : PTypeInfo; Const AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure PutUInt64( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} procedure PutObj( Const AName : String; Const ATypeInfo : PTypeInfo; @@ -332,6 +339,13 @@ type Var AName : String; Var AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure GetUInt64( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF} procedure GetAnsiStr( Const ATypeInfo : PTypeInfo; Var AName : String; @@ -1119,6 +1133,17 @@ begin StackTop().CreateBuffer(AName,dtInt64S)^.Int64S := AData; end; +{$IFDEF HAS_QWORD} +procedure TBaseBinaryFormatter.PutUInt64( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: QWord +); +begin + StackTop().CreateBuffer(AName,dtInt64U)^.Int64U := AData; +end; +{$ENDIF HAS_QWORD} + procedure TBaseBinaryFormatter.PutObj( const AName: String; const ATypeInfo: PTypeInfo; @@ -1229,6 +1254,17 @@ begin AData := GetDataBuffer(AName)^.Int64S; end; +{$IFDEF HAS_QWORD} +procedure TBaseBinaryFormatter.GetUInt64( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: QWord +); +begin + AData := GetDataBuffer(AName)^.Int64U; +end; +{$ENDIF HAS_QWORD} + procedure TBaseBinaryFormatter.GetAnsiStr( const ATypeInfo: PTypeInfo; var AName: String; @@ -1404,6 +1440,9 @@ end; procedure TBaseBinaryFormatter.Put(const AName: String; const ATypeInfo: PTypeInfo;const AData); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWOrd; +{$ENDIF HAS_QWORD} ansiStrData : AnsiString; objData : TObject; boolData : Boolean; @@ -1444,11 +1483,18 @@ begin PutUnicodeStr(AName,ATypeInfo,unicodeStrData); end; {$ENDIF WST_UNICODESTRING} - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := Int64(AData); PutInt64(AName,ATypeInfo,int64Data); End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := QWord(AData); + PutUInt64(AName,ATypeInfo,uint64Data); + End; +{$ENDIF HAS_QWORD} tkClass : Begin objData := TObject(AData); @@ -1523,7 +1569,9 @@ procedure TBaseBinaryFormatter.PutScopeInnerValue( ); var int64SData : Int64; - {$IFDEF FPC}int64UData : QWord;{$ENDIF} +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; boolData : Boolean; enumData : TEnumData; @@ -1569,13 +1617,13 @@ begin int64SData := Int64(AData); StackTop().CreateInnerBuffer(dtInt64S)^.Int64S := int64SData; end; - {$IFDEF FPC} +{$IFDEF HAS_QWORD} tkQWord : begin - int64UData := QWord(AData); - StackTop().CreateInnerBuffer(dtInt64U)^.Int64U := int64UData; + uint64Data := QWord(AData); + StackTop().CreateInnerBuffer(dtInt64U)^.Int64U := uint64Data; end; - {$ENDIF} +{$ENDIF HAS_QWORD} tkClass, tkRecord : begin raise EBinaryFormatterException.Create('Inner Scope value must be a "simple type" value.'); @@ -1690,6 +1738,9 @@ procedure TBaseBinaryFormatter.Get( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWOrd; +{$ENDIF HAS_QWORD} strData : AnsiString; objData : TObject; boolData : Boolean; @@ -1704,12 +1755,20 @@ Var wideCharData : WideChar; begin Case ATypeInfo^.Kind Of - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := 0; GetInt64(ATypeInfo,AName,int64Data); Int64(AData) := int64Data; End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := 0; + GetUInt64(ATypeInfo,AName,uint64Data); + QWord(AData) := uint64Data; + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; @@ -1829,9 +1888,9 @@ begin tkChar : AnsiChar(AData) := dataBuffer^.AnsiCharData ; tkWChar : WideChar(AData) := dataBuffer^.WideCharData ; tkInt64 : Int64(AData) := dataBuffer^.Int64S; - {$IFDEF FPC} +{$IFDEF HAS_QWORD} tkQWord : QWord(AData) := dataBuffer^.Int64U; - {$ENDIF} +{$ENDIF HAS_QWORD} tkLString {$IFDEF FPC}, diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index 4f0ec4271..5acaf5dd6 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -71,6 +71,12 @@ type Const AName : string; const AValue : Int64 ) : TJSONData;virtual; +{$IFDEF HAS_QWORD} + function CreateUInt64Buffer( + Const AName : string; + const AValue : QWord + ) : TJSONData;virtual; +{$ENDIF HAS_QWORD} function CreateFloatBuffer( Const AName : string; const AValue : TJSONFloat @@ -223,6 +229,13 @@ type Const ATypeInfo : PTypeInfo; Const AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure PutUInt64( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} procedure PutStr( Const AName : String; Const ATypeInfo : PTypeInfo; @@ -289,6 +302,13 @@ type Var AName : String; Var AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure GetUInt64( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} procedure GetFloat( Const ATypeInfo : PTypeInfo; Var AName : String; @@ -506,6 +526,17 @@ begin StackTop().CreateInt64Buffer(AName,AData); end; +{$IFDEF HAS_QWORD} +procedure TJsonRpcBaseFormatter.PutUInt64( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : QWord +); +begin + StackTop().CreateUInt64Buffer(AName,AData); +end; +{$ENDIF HAS_QWORD} + procedure TJsonRpcBaseFormatter.PutStr( const AName : String; const ATypeInfo : PTypeInfo; @@ -641,6 +672,34 @@ begin AData := Round(locBuffer.AsFloat); end; +{$IFDEF HAS_QWORD} +procedure TJsonRpcBaseFormatter.GetUInt64( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : QWord +); +var + locBuffer : TJSONData; + locExtData : TJSONFloat; + tmp : QWord; +begin + locBuffer := GetDataBuffer(AName); + if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin + AData := locBuffer.AsInteger + end else begin + locExtData := locBuffer.AsFloat; + if ( locExtData > High(Int64) ) then begin + locExtData := locExtData - High(Int64); + AData := High(Int64); + tmp := Round(locExtData); + AData := AData + tmp; + end else begin + AData := Round(locExtData); + end; + end; +end; +{$ENDIF HAS_QWORD} + procedure TJsonRpcBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; var AName : String; @@ -874,6 +933,9 @@ procedure TJsonRpcBaseFormatter.Put( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -914,11 +976,18 @@ begin wideStrData := WideString(AData); PutWideStr(AName,ATypeInfo,wideStrData); end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := Int64(AData); PutInt64(AName,ATypeInfo,int64Data); End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := QWord(AData); + PutUInt64(AName,ATypeInfo,uint64Data); + End; +{$ENDIF HAS_QWORD} tkClass : Begin objData := TObject(AData); @@ -991,6 +1060,9 @@ procedure TJsonRpcBaseFormatter.PutScopeInnerValue(const ATypeInfo : PTypeInfo; var locName : string; int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -1032,11 +1104,18 @@ begin PutUnicodeStr(locName,ATypeInfo,unicodeStrData); end; {$ENDIF WST_UNICODESTRING} - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := Int64(AData); PutInt64(locName,ATypeInfo,int64Data); End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := QWord(AData); + PutUInt64(locName,ATypeInfo,uint64Data); + End; +{$ENDIF HAS_QWORD} tkClass, tkRecord : begin raise EJsonRpcException.Create('Inner Scope value must be a "simple type" value.'); @@ -1097,6 +1176,9 @@ procedure TJsonRpcBaseFormatter.Get( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -1123,12 +1205,20 @@ begin GetWideChar(ATypeInfo,AName,wideCharData); WideChar(AData) := wideCharData; end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := 0; GetInt64(ATypeInfo,AName,int64Data); Int64(AData) := int64Data; End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := 0; + GetUInt64(ATypeInfo,AName,uint64Data); + QWord(AData) := uint64Data; + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; @@ -1227,6 +1317,9 @@ procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var locName : string; int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -1254,12 +1347,20 @@ begin GetWideChar(ATypeInfo,locName,wideCharData); WideChar(AData) := wideCharData; end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := 0; GetInt64(ATypeInfo,locName,int64Data); Int64(AData) := int64Data; End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := 0; + GetUInt64(ATypeInfo,locName,uint64Data); + QWord(AData) := uint64Data; + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; @@ -1453,6 +1554,16 @@ begin Result := CreateFloatBuffer(AName,AValue); end; +{$IFDEF HAS_QWORD} +function TStackItem.CreateUInt64Buffer( + const AName : string; + const AValue : QWord +) : TJSONData; +begin + Result := CreateFloatBuffer(AName,AValue); +end; +{$ENDIF HAS_QWORD} + { TObjectStackItem } function TObjectStackItem.GetDataObject() : TJSONObject; diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index cb054efdf..fea503206 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -186,6 +186,14 @@ type Const ATypeInfo : PTypeInfo; Const AData : Int64 ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + function PutUInt64( + const ANameSpace : string; + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : QWord + ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} function PutStr( const ANameSpace : string; Const AName : String; @@ -262,6 +270,14 @@ type Var AName : String; Var AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure GetUInt64( + Const ATypeInfo : PTypeInfo; + const ANameSpace : string; + Var AName : String; + Var AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} procedure GetFloat( Const ATypeInfo : PTypeInfo; const ANameSpace : string; @@ -918,6 +934,18 @@ begin Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData)); end; +{$IFDEF HAS_QWORD} +function TSOAPBaseFormatter.PutUInt64( + const ANameSpace : string; + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : QWord +): TDOMNode; +begin + Result := InternalPutData(ANameSpace,AName,ATypeInfo,IntToStr(AData)); +end; +{$ENDIF HAS_QWORD} + function TSOAPBaseFormatter.PutStr( const ANameSpace : string; const AName: String; @@ -1099,6 +1127,18 @@ begin AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0); end; +{$IFDEF HAS_QWORD} +procedure TSOAPBaseFormatter.GetUInt64( + const ATypeInfo : PTypeInfo; + const ANameSpace : string; + var AName : String; + var AData : QWord +); +begin + AData := StrToQWordDef(Trim(GetNodeValue(ANameSpace,AName)),0); +end; +{$ENDIF HAS_QWORD} + procedure TSOAPBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; const ANameSpace : string; @@ -1654,6 +1694,9 @@ procedure TSOAPBaseFormatter.Put( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -1677,11 +1720,18 @@ begin wideCharData := WideChar(AData); PutWideChar(ANameSpace,AName,ATypeInfo,wideCharData); end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := Int64(AData); PutInt64(ANameSpace,AName,ATypeInfo,int64Data); End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := QWord(AData); + PutUInt64(ANameSpace,AName,ATypeInfo,uint64Data); + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := String(AData); @@ -1731,8 +1781,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); End; If ( ATypeInfo^.Kind = tkInteger ) Then PutInt64(ANameSpace,AName,ATypeInfo,enumData) @@ -1772,10 +1822,12 @@ procedure TSOAPBaseFormatter.PutScopeInnerValue( ); Var int64SData : Int64; - {$IFDEF FPC} - int64UData : QWord; - boolData : Boolean; - {$ENDIF} +{$IFDEF FPC} + boolData : Boolean; +{$ENDIF FPC} +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; enumData : TEnumIntType; floatDt : Extended; @@ -1804,13 +1856,13 @@ begin int64SData := Int64(AData); dataBuffer := IntToStr(int64SData); end; - {$IFDEF FPC} +{$IFDEF HAS_QWORD} tkQWord : begin - int64UData := QWord(AData); - dataBuffer := IntToStr(int64UData); + uint64Data := QWord(AData); + dataBuffer := IntToStr(uint64Data); end; - {$ENDIF} +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : begin strData := string(AData); @@ -1846,8 +1898,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); end; dataBuffer := IntToStr(enumData); end; @@ -1859,8 +1911,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); end; dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData)) end; @@ -1888,6 +1940,9 @@ procedure TSOAPBaseFormatter.Get( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; boolData : Boolean; @@ -1914,12 +1969,20 @@ begin GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData); WideChar(AData) := wideCharData; end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := 0; GetInt64(ATypeInfo,ANameSpace,AName,int64Data); Int64(AData) := int64Data; End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := 0; + GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data); + QWord(AData) := uint64Data; + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; @@ -1980,8 +2043,8 @@ begin otUByte : Byte(AData) := enumData; otSWord : SmallInt(AData) := enumData; otUWord : Word(AData) := enumData; - otSLong, - otULong : LongInt(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; End; {$IFDEF WST_DELPHI} end; @@ -2045,9 +2108,9 @@ begin WideChar(AData) := #0; end; tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0); - {$IFDEF FPC} - tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0); - {$ENDIF} +{$IFDEF HAS_QWORD} + tkQWord : QWord(AData) := StrToQWordDef(Trim(dataBuffer),0); +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : string(AData) := dataBuffer; tkWString : WideString(AData) := dataBuffer; {$IFDEF WST_UNICODESTRING} @@ -2070,7 +2133,7 @@ begin tkInteger, tkEnumeration : begin if ( ATypeInfo^.Kind = tkInteger ) then - enumData := StrToIntDef(Trim(dataBuffer),0) + enumData := StrToInt64Def(Trim(dataBuffer),0) else enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer)); case GetTypeData(ATypeInfo)^.OrdType of @@ -2078,8 +2141,8 @@ begin otUByte : Byte(AData) := enumData; otSWord : SmallInt(AData) := enumData; otUWord : Word(AData) := enumData; - otSLong, - otULong : LongInt(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; end; end; tkFloat : diff --git a/wst/trunk/base_xmlrpc_formatter.pas b/wst/trunk/base_xmlrpc_formatter.pas index 7b33f0b31..a2b80e34f 100644 --- a/wst/trunk/base_xmlrpc_formatter.pas +++ b/wst/trunk/base_xmlrpc_formatter.pas @@ -201,6 +201,13 @@ type Const ATypeInfo : PTypeInfo; Const AData : Int64 ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + function PutUInt64( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : QWord + ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} function PutStr( Const AName : String; Const ATypeInfo : PTypeInfo; @@ -267,6 +274,13 @@ type Var AName : String; Var AData : Int64 );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$IFDEF HAS_QWORD} + procedure GetUInt64( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : QWord + );{$IFDEF USE_INLINE}inline;{$ENDIF} +{$ENDIF HAS_QWORD} procedure GetFloat( Const ATypeInfo : PTypeInfo; Var AName : String; @@ -858,6 +872,17 @@ begin Result := InternalPutData(AName,xdtInt,IntToStr(AData)); end; +{$IFDEF HAS_QWORD} +function TXmlRpcBaseFormatter.PutUInt64( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : QWord +): TDOMNode; +begin + Result := InternalPutData(AName,xdtInt,IntToStr(AData)); +end; +{$ENDIF HAS_QWORD} + function TXmlRpcBaseFormatter.PutStr( const AName: String; const ATypeInfo: PTypeInfo; @@ -1028,6 +1053,17 @@ begin AData := StrToInt64Def(Trim(GetNodeValue(AName)),0); end; +{$IFDEF HAS_QWORD} +procedure TXmlRpcBaseFormatter.GetUInt64( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : QWord +); +begin + AData := StrToQWordDef(Trim(GetNodeValue(AName)),0); +end; +{$ENDIF HAS_QWORD} + procedure TXmlRpcBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; var AName : String; @@ -1258,6 +1294,9 @@ procedure TXmlRpcBaseFormatter.Put( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; {$IFDEF FPC}boolData : Boolean;{$ENDIF} @@ -1281,11 +1320,18 @@ begin wideCharData := WideChar(AData); PutWideChar(AName,ATypeInfo,wideCharData); end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := Int64(AData); PutInt64(AName,ATypeInfo,int64Data); End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := QWord(AData); + PutUInt64(AName,ATypeInfo,uint64Data); + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := String(AData); @@ -1327,8 +1373,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); End; If ( ATypeInfo^.Kind = tkInteger ) Then PutInt64(AName,ATypeInfo,enumData) @@ -1365,10 +1411,12 @@ procedure TXmlRpcBaseFormatter.PutScopeInnerValue( ); Var int64SData : Int64; - {$IFDEF FPC} - int64UData : QWord; - boolData : Boolean; - {$ENDIF} +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} +{$IFDEF FPC} + boolData : Boolean; +{$ENDIF} strData : string; enumData : TEnumIntType; floatDt : Extended; @@ -1397,13 +1445,13 @@ begin int64SData := Int64(AData); dataBuffer := IntToStr(int64SData); end; - {$IFDEF FPC} +{$IFDEF HAS_QWORD} tkQWord : begin - int64UData := QWord(AData); - dataBuffer := IntToStr(int64UData); + uint64Data := QWord(AData); + dataBuffer := IntToStr(uint64Data); end; - {$ENDIF} +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : begin strData := string(AData); @@ -1439,8 +1487,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); end; dataBuffer := IntToStr(enumData); end; @@ -1452,8 +1500,8 @@ begin otUByte : enumData := Byte(AData); otSWord : enumData := SmallInt(AData); otUWord : enumData := Word(AData); - otSLong, - otULong : enumData := LongInt(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); end; dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData)) end; @@ -1480,6 +1528,9 @@ procedure TXmlRpcBaseFormatter.Get( ); Var int64Data : Int64; +{$IFDEF HAS_QWORD} + uint64Data : QWord; +{$ENDIF HAS_QWORD} strData : string; objData : TObject; {$IFDEF FPC}boolData : Boolean;{$ENDIF} @@ -1506,12 +1557,20 @@ begin GetWideChar(ATypeInfo,AName,wideCharData); WideChar(AData) := wideCharData; end; - tkInt64{$IFDEF FPC},tkQWord{$ENDIF} : + tkInt64 : Begin int64Data := 0; GetInt64(ATypeInfo,AName,int64Data); Int64(AData) := int64Data; End; +{$IFDEF HAS_QWORD} + tkQWord : + Begin + uint64Data := 0; + GetUInt64(ATypeInfo,AName,uint64Data); + QWord(AData) := uint64Data; + End; +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; @@ -1563,8 +1622,8 @@ begin otUByte : Byte(AData) := enumData; otSWord : SmallInt(AData) := enumData; otUWord : Word(AData) := enumData; - otSLong, - otULong : LongInt(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; End; End; tkFloat : @@ -1626,9 +1685,9 @@ begin WideChar(AData) := #0; end; tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0); - {$IFDEF FPC} - tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0); - {$ENDIF} +{$IFDEF HAS_QWORD} + tkQWord : QWord(AData) := StrToQWordDef(Trim(dataBuffer),0); +{$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : string(AData) := dataBuffer; tkWString : WideString(AData) := dataBuffer; {$IFDEF WST_UNICODESTRING} @@ -1651,7 +1710,7 @@ begin tkInteger, tkEnumeration : begin if ( ATypeInfo^.Kind = tkInteger ) then - enumData := StrToIntDef(Trim(dataBuffer),0) + enumData := StrToInt64Def(Trim(dataBuffer),0) else enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer)); case GetTypeData(ATypeInfo)^.OrdType of @@ -1659,8 +1718,8 @@ begin otUByte : Byte(AData) := enumData; otSWord : SmallInt(AData) := enumData; otUWord : Word(AData) := enumData; - otSLong, - otULong : LongInt(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; end; end; tkFloat : diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 4fdf1cb65..b2d6be8fd 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -1299,7 +1299,7 @@ begin end; procedure TTestFormatterSimpleType.Test_Int_32_ScopeData; -const VAL_1 = 121076; VAL_2 : LongInt = -101276; +const VAL_1 = 3294967295; VAL_2 : LongInt = -101276; var f : IFormatterBase; s : TMemoryStream; @@ -1351,7 +1351,7 @@ begin end; procedure TTestFormatterSimpleType.Test_Int_64; -const VAL_1 = $FFFFFFFFFF; VAL_2 : Int64 = -$FFFFFFFFF0; +const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -$FFFFFFFFF0; Var f : IFormatterBase; s : TMemoryStream; @@ -1393,7 +1393,7 @@ begin end; procedure TTestFormatterSimpleType.Test_Int_64_ScopeData; -const VAL_1 = 121076; VAL_2 : Int64 = -101276; +const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -101276; var f : IFormatterBase; s : TMemoryStream; @@ -2118,7 +2118,11 @@ const CONST_Val_16S = -$7FFF; CONST_Val_32U = $FFFFFFFE; CONST_Val_32S = -$7FFFFFFF; +{$IFDEF HAS_BUILT_IN_64UINT} + CONST_Val_64U = 18446744073709551604{ = $FFFFFFFFFFFFFFF4}; +{$ELSE HAS_BUILT_IN_64UINT} CONST_Val_64U = $FFFFFFFFFFFFF; +{$ENDIF HAS_BUILT_IN_64UINT} CONST_Val_64S = -$FFFFFFFFFFFFF; Var f : IFormatterBase; @@ -5157,8 +5161,8 @@ end; function TTestBinaryFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; begin - Result := TSOAPBaseFormatter.Create() as IFormatterBase; - Result.BeginObject('Env',ARootType); + Result := TBaseBinaryFormatter.Create() as IFormatterBase; + //Result.BeginObject('Root',ARootType); Result.SetSerializationStyle(ssAttibuteSerialization); end; diff --git a/wst/trunk/wst_global.inc b/wst/trunk/wst_global.inc index af3e0497b..5748eb396 100644 --- a/wst/trunk/wst_global.inc +++ b/wst/trunk/wst_global.inc @@ -9,6 +9,7 @@ {$IFDEF FPC} {$mode objfpc}{$H+} {$DEFINE HAS_QWORD} + {$DEFINE HAS_BUILT_IN_64UINT} {$DEFINE HAS_TKBOOL} {$UNDEF WST_INTF_DOM} //{$DEFINE USE_INLINE} @@ -46,6 +47,7 @@ {$DEFINE HAS_FORMAT_SETTINGS} {$ENDIF} {$IFDEF VER200} // Delphi 2009 + {$DEFINE HAS_BUILT_IN_64UINT} {$DEFINE WST_UNICODESTRING} {$DEFINE USE_INLINE} {$ENDIF}