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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@855 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/base_soap_formatter.pas

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

wst/trunk/base_xmlrpc_formatter.pas

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

wst/trunk/object_serializer.pas

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

wst/trunk/tests/test_suite/testformatter_unit.pas

@@ -2261,6 +2261,37 @@ begin
     CheckEquals(True,a.Val_Bool);
     CheckEquals(Ord(teThree),Ord(a.Val_Enum));
     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
     a.Free();
     s.Free();