pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

XMLRPC/SOAP serializers: Better Boolean handling, fix Delphi bug

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@855 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-06-18 17:03:43 +00:00
parent 2738707f90
commit b0d48481ec
4 changed files with 179 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
wst/trunk/base_soap_formatter.pas
View File

@ -1822,9 +1822,7 @@ procedure TSOAPBaseFormatter.PutScopeInnerValue(
); );
Var Var
int64SData : Int64; int64SData : Int64;
{$IFDEF FPC}
boolData : Boolean; boolData : Boolean;
{$ENDIF FPC}
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
uint64Data : QWord; uint64Data : QWord;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
@ -1905,16 +1903,25 @@ begin
end; end;
tkEnumeration : tkEnumeration :
begin begin
enumData := 0; {$IFDEF WST_DELPHI}
case GetTypeData(ATypeInfo)^.OrdType of if ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin
otSByte : enumData := ShortInt(AData); boolData := Boolean(AData);
otUByte : enumData := Byte(AData); dataBuffer := BoolToSoapBool(boolData);
otSWord : enumData := SmallInt(AData); end else begin
otUWord : enumData := Word(AData); {$ENDIF}
otSLong : enumData := LongInt(AData); enumData := 0;
otULong : enumData := LongWord(AData); case GetTypeData(ATypeInfo)^.OrdType of
otSByte : enumData := ShortInt(AData);
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
{$IFDEF WST_DELPHI}
end; end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData)) {$ENDIF}
end; end;
tkFloat : tkFloat :
begin begin
@ -2132,18 +2139,32 @@ begin
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
begin begin
if ( ATypeInfo^.Kind = tkInteger ) then {$IFDEF WST_DELPHI}
enumData := StrToInt64Def(Trim(dataBuffer),0) if ( ATypeInfo^.Kind = tkEnumeration ) and
else ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer)); then begin
case GetTypeData(ATypeInfo)^.OrdType of dataBuffer := LowerCase(Trim(dataBuffer));
otSByte : ShortInt(AData) := enumData; if IsStrEmpty(dataBuffer) then
otUByte : Byte(AData) := enumData; Boolean(AData) := False
otSWord : SmallInt(AData) := enumData; else
otUWord : Word(AData) := enumData; Boolean(AData) := StrToBool(dataBuffer);
otSLong : LongInt(AData) := enumData; end else begin
otULong : LongWord(AData) := enumData; {$ENDIF}
if ( ATypeInfo^.Kind = tkInteger ) then
enumData := StrToInt64Def(Trim(dataBuffer),0)
else
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : ShortInt(AData) := enumData;
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
end;
{$IFDEF WST_DELPHI}
end; end;
{$ENDIF}
end; end;
tkFloat : tkFloat :
begin begin

177
wst/trunk/base_xmlrpc_formatter.pas
View File

@ -41,6 +41,9 @@ const
sPARAMS = 'params'; sPARAMS = 'params';
sVALUE = 'value'; sVALUE = 'value';
XML_RPC_FALSE = '0';
XML_RPC_TRUE = '1';
type type
TwstXMLDocument = {$IFNDEF FPC}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF}; TwstXMLDocument = {$IFNDEF FPC}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF};
@ -179,13 +182,11 @@ type
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Const AData : TEnumIntType Const AData : TEnumIntType
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
function PutBool( function PutBool(
Const AName : String; Const AName : String;
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Const AData : Boolean Const AData : Boolean
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF} ):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
function PutAnsiChar( function PutAnsiChar(
Const AName : String; Const AName : String;
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
@ -257,7 +258,6 @@ type
Var AName : String; Var AName : String;
Var AData : WideChar Var AData : WideChar
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetBool( procedure GetBool(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
@ -268,7 +268,6 @@ type
Var AName : String; Var AName : String;
Var AData : Integer Var AData : Integer
); );
{$ENDIF}
procedure GetInt64( procedure GetInt64(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
Var AName : String; Var AName : String;
@ -828,7 +827,6 @@ begin
); );
end; end;
{$IFDEF FPC}
function TXmlRpcBaseFormatter.PutBool( function TXmlRpcBaseFormatter.PutBool(
const AName : String; const AName : String;
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
@ -838,12 +836,11 @@ var
v : Char; v : Char;
begin begin
if AData then if AData then
v := '1' v := XML_RPC_TRUE
else else
v := '0'; v := XML_RPC_FALSE;
Result := InternalPutData(AName,xdtBoolean,v); Result := InternalPutData(AName,xdtBoolean,v);
end; end;
{$ENDIF}
function TXmlRpcBaseFormatter.PutAnsiChar( function TXmlRpcBaseFormatter.PutAnsiChar(
const AName: String; const AName: String;
@ -988,20 +985,13 @@ begin
AData := GetEnumValue(ATypeInfo,locBuffer) AData := GetEnumValue(ATypeInfo,locBuffer)
End; End;
{$IFDEF FPC}
procedure TXmlRpcBaseFormatter.GetBool( procedure TXmlRpcBaseFormatter.GetBool(
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
var AName : String; var AName : String;
var AData : Boolean var AData : Boolean
); );
Var
locBuffer : String;
begin begin
locBuffer := LowerCase(Trim(GetNodeValue(AName))); AData := ( GetNodeValue(AName) = XML_RPC_TRUE );
If IsStrEmpty(locBuffer) Then
AData := False
Else
AData := StrToBool(locBuffer);
end; end;
procedure TXmlRpcBaseFormatter.GetInt( procedure TXmlRpcBaseFormatter.GetInt(
@ -1012,7 +1002,6 @@ procedure TXmlRpcBaseFormatter.GetInt(
begin begin
AData := StrToIntDef(Trim(GetNodeValue(AName)),0); AData := StrToIntDef(Trim(GetNodeValue(AName)),0);
end; end;
{$ENDIF}
procedure TXmlRpcBaseFormatter.GetAnsiChar( procedure TXmlRpcBaseFormatter.GetAnsiChar(
const ATypeInfo: PTypeInfo; const ATypeInfo: PTypeInfo;
@ -1299,7 +1288,7 @@ Var
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
strData : string; strData : string;
objData : TObject; objData : TObject;
{$IFDEF FPC}boolData : Boolean;{$ENDIF} boolData : Boolean;
enumData : TEnumIntType; enumData : TEnumIntType;
floatDt : Extended; floatDt : Extended;
{$IFDEF WST_UNICODESTRING} {$IFDEF WST_UNICODESTRING}
@ -1367,19 +1356,30 @@ begin
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
Begin Begin
enumData := 0; {$IFDEF WST_DELPHI}
Case GetTypeData(ATypeInfo)^.OrdType Of if ( ATypeInfo^.Kind = tkEnumeration ) and
otSByte : enumData := ShortInt(AData); ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
otUByte : enumData := Byte(AData); then begin
otSWord : enumData := SmallInt(AData); boolData := Boolean(AData);
otUWord : enumData := Word(AData); PutBool(AName,ATypeInfo,boolData);
otSLong : enumData := LongInt(AData); end else begin
otULong : enumData := LongWord(AData); {$ENDIF}
End; enumData := 0;
If ( ATypeInfo^.Kind = tkInteger ) Then Case GetTypeData(ATypeInfo)^.OrdType Of
PutInt64(AName,ATypeInfo,enumData) otSByte : enumData := ShortInt(AData);
Else otUByte : enumData := Byte(AData);
PutEnum(AName,ATypeInfo,enumData); otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
End;
If ( ATypeInfo^.Kind = tkInteger ) Then
PutInt64(AName,ATypeInfo,enumData)
Else
PutEnum(AName,ATypeInfo,enumData);
{$IFDEF WST_DELPHI}
end;
{$ENDIF}
End; End;
tkFloat : tkFloat :
Begin Begin
@ -1414,9 +1414,7 @@ Var
{$IFDEF HAS_QWORD} {$IFDEF HAS_QWORD}
uint64Data : QWord; uint64Data : QWord;
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
{$IFDEF FPC}
boolData : Boolean; boolData : Boolean;
{$ENDIF}
strData : string; strData : string;
enumData : TEnumIntType; enumData : TEnumIntType;
floatDt : Extended; floatDt : Extended;
@ -1477,7 +1475,10 @@ begin
tkBool : tkBool :
begin begin
boolData := Boolean(AData); boolData := Boolean(AData);
dataBuffer := BoolToStr(boolData); if boolData then
dataBuffer := XML_RPC_TRUE
else
dataBuffer := XML_RPC_FALSE;
end; end;
{$ENDIF} {$ENDIF}
tkInteger : tkInteger :
@ -1494,16 +1495,28 @@ begin
end; end;
tkEnumeration : tkEnumeration :
begin begin
enumData := 0; {$IFDEF WST_DELPHI}
case GetTypeData(ATypeInfo)^.OrdType of if ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin
otSByte : enumData := ShortInt(AData); boolData := Boolean(AData);
otUByte : enumData := Byte(AData); if boolData then
otSWord : enumData := SmallInt(AData); dataBuffer := XML_RPC_TRUE
otUWord : enumData := Word(AData); else
otSLong : enumData := LongInt(AData); dataBuffer := XML_RPC_FALSE;
otULong : enumData := LongWord(AData); end else begin
{$ENDIF}
enumData := 0;
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : enumData := ShortInt(AData);
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
{$IFDEF WST_DELPHI}
end; end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData)) {$ENDIF}
end; end;
tkFloat : tkFloat :
begin begin
@ -1533,7 +1546,7 @@ Var
{$ENDIF HAS_QWORD} {$ENDIF HAS_QWORD}
strData : string; strData : string;
objData : TObject; objData : TObject;
{$IFDEF FPC}boolData : Boolean;{$ENDIF} boolData : Boolean;
enumData : TEnumIntType; enumData : TEnumIntType;
floatDt : Extended; floatDt : Extended;
recObject : Pointer; recObject : Pointer;
@ -1612,19 +1625,31 @@ begin
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
Begin Begin
enumData := 0; {$IFDEF WST_DELPHI}
If ( ATypeInfo^.Kind = tkInteger ) Then if ( ATypeInfo^.Kind = tkEnumeration ) and
GetInt64(ATypeInfo,AName,enumData) ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
Else then begin
GetEnum(ATypeInfo,AName,enumData); boolData := False;
Case GetTypeData(ATypeInfo)^.OrdType Of GetBool(ATypeInfo,AName,boolData);
otSByte : ShortInt(AData) := enumData; Boolean(AData) := boolData;
otUByte : Byte(AData) := enumData; end else begin
otSWord : SmallInt(AData) := enumData; {$ENDIF}
otUWord : Word(AData) := enumData; enumData := 0;
otSLong : LongInt(AData) := enumData; If ( ATypeInfo^.Kind = tkInteger ) Then
otULong : LongWord(AData) := enumData; GetInt64(ATypeInfo,AName,enumData)
End; Else
GetEnum(ATypeInfo,AName,enumData);
Case GetTypeData(ATypeInfo)^.OrdType Of
otSByte : ShortInt(AData) := enumData;
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
End;
{$IFDEF WST_DELPHI}
end;
{$ENDIF}
End; End;
tkFloat : tkFloat :
Begin Begin
@ -1700,27 +1725,33 @@ begin
{$IFDEF FPC} {$IFDEF FPC}
tkBool : tkBool :
begin begin
dataBuffer := LowerCase(Trim(dataBuffer)); Boolean(AData) := ( dataBuffer = XML_RPC_TRUE );
if IsStrEmpty(dataBuffer) then
Boolean(AData) := False
else
Boolean(AData) := StrToBool(dataBuffer);
end; end;
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
begin begin
if ( ATypeInfo^.Kind = tkInteger ) then {$IFDEF WST_DELPHI}
enumData := StrToInt64Def(Trim(dataBuffer),0) if ( ATypeInfo^.Kind = tkEnumeration ) and
else ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) )
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer)); then begin
case GetTypeData(ATypeInfo)^.OrdType of Boolean(AData) := ( dataBuffer = XML_RPC_TRUE );
otSByte : ShortInt(AData) := enumData; end else begin
otUByte : Byte(AData) := enumData; {$ENDIF}
otSWord : SmallInt(AData) := enumData; if ( ATypeInfo^.Kind = tkInteger ) then
otUWord : Word(AData) := enumData; enumData := StrToInt64Def(Trim(dataBuffer),0)
otSLong : LongInt(AData) := enumData; else
otULong : LongWord(AData) := enumData; enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : ShortInt(AData) := enumData;
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong : LongInt(AData) := enumData;
otULong : LongWord(AData) := enumData;
end;
{$IFDEF WST_DELPHI}
end; end;
{$ENDIF}
end; end;
tkFloat : tkFloat :
begin begin

2
wst/trunk/object_serializer.pas
View File

@ -16,7 +16,7 @@ unit object_serializer;
interface interface
uses uses
Classes, SysUtils, TypInfo, Contnrs, SyncObjs, Classes, SysUtils, TypInfo, Contnrs,
base_service_intf, wst_types; base_service_intf, wst_types;
type type

31
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -2261,6 +2261,37 @@ begin
CheckEquals(True,a.Val_Bool); CheckEquals(True,a.Val_Bool);
CheckEquals(Ord(teThree),Ord(a.Val_Enum)); CheckEquals(Ord(teThree),Ord(a.Val_Enum));
CheckEquals('atou',a.Val_String); CheckEquals('atou',a.Val_String);
//------------------------------------
FreeAndNil(a);
a := TClass_Enum.Create();
a.Val_Bool := False;
a.Val_Enum := teTwo;
a.Val_String := 'atoukws';
f := CreateFormatter(TypeInfo(TClass_Enum));
f.BeginObject('Root',TypeInfo(TClass_Enum));
f.Put('o1',TypeInfo(TClass_Enum),a);
f.EndScope();
s.Clear();
f.SaveToStream(s);
FreeAndNil(a);
a := TClass_Enum.Create();
f := CreateFormatter(TypeInfo(TClass_Enum));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Enum));
x := 'o1';
f.Get(TypeInfo(TClass_Enum),x,a);
f.EndScopeRead();
CheckEquals(False,a.Val_Bool);
CheckEquals(Ord(teTwo),Ord(a.Val_Enum));
CheckEquals('atoukws',a.Val_String);
Finally Finally
a.Free(); a.Free();
s.Free(); s.Free();