Keep the Soap Style even after an exception

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

wst/trunk/soap_formatter.pas

@@ -117,6 +117,7 @@ Var
   nsShortName,eltName, msgBuff : string;
   excpt_Obj : ESOAPException;
   doc : TXMLDocument;
+  oldStyle : TSOAPDocumentStyle;
 begin
   ClearStack();
   doc := GetXmlDoc();
@@ -166,26 +167,31 @@ begin
   end;
   eltName := nsShortName + 'Fault';
   If SameText(eltName,bdyNd.FirstChild.NodeName) Then Begin
+    oldStyle := Self.Style;
     Self.Style := RPC;
-    fltNd := bdyNd.FirstChild;
+    try
-    PushStack(fltNd);
+      fltNd := bdyNd.FirstChild;
-    excpt_Obj := ESOAPException.Create('');
+      PushStack(fltNd);
-    Try
+      excpt_Obj := ESOAPException.Create('');
-      eltName := 'faultcode';
+      try
-      Get(TypeInfo(string),eltName,msgBuff);
+        eltName := 'faultcode';
-      excpt_Obj.FaultCode := msgBuff;
+        Get(TypeInfo(string),eltName,msgBuff);
-      eltName := 'faultstring';
+        excpt_Obj.FaultCode := msgBuff;
-      Get(TypeInfo(string),eltName,msgBuff);
+        eltName := 'faultstring';
-      excpt_Obj.FaultString := msgBuff;                   ;
+        Get(TypeInfo(string),eltName,msgBuff);
-      excpt_Obj.Message := Format(
+        excpt_Obj.FaultString := msgBuff;                   ;
-        'Service exception :%s   Code = "%s"%s   Message = "%s"',
+        excpt_Obj.Message := Format(
-        [LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString]
+          'Service exception :%s   Code = "%s"%s   Message = "%s"',
-      );
+          [LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString]
-    Except
+        );
-      FreeAndNil(excpt_Obj);
+      except
-      Raise;
+        FreeAndNil(excpt_Obj);
-    End;
+        raise;
-    Raise excpt_Obj;
+      end;
+      raise excpt_Obj;
+    finally
+      Self.Style := oldStyle;
+    end;
   End;
 end;
 

wst/trunk/tests/test_suite/testformatter_unit.pas

@@ -484,6 +484,7 @@ type
   published
     procedure ExceptBlock_server();
     procedure ExceptBlock_client();
+    procedure client_keep_style();
   end;
 
   { TTest_XmlRpcFormatterExceptionBlock }
@@ -3801,6 +3802,71 @@ begin
   end;
 end;
 
+procedure TTest_SoapFormatterExceptionBlock.client_keep_style();
+const
+  VAL_CODE = 'Server.CustomCode.Test'; VAL_MSG = 'This is a sample exception message.';
+  VAL_STREAM =
+    '<?xml version="1.0"?> '+
+    ' <SOAP-ENV:Envelope ' +
+        ' xmlns:xsd="http://www.w3.org/2001/XMLSchema" ' +
+        ' xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" ' +
+        ' xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"> ' +
+     ' <SOAP-ENV:Body> '+
+       ' <SOAP-ENV:Fault> '+
+         ' <faultcode>' + VAL_CODE + '</faultcode> '+
+         ' <faultstring>' + VAL_MSG +'</faultstring> '+
+       ' </SOAP-ENV:Fault> '+
+     ' </SOAP-ENV:Body> '+
+    ' </SOAP-ENV:Envelope>';
+var
+  f : IFormatterClient;
+  strm : TStringStream;
+  excpt_code, excpt_msg : string;
+begin
+  excpt_code := '';
+  excpt_msg := '';
+  f := CreateFormatterClient();
+  f.GetPropertyManager().SetProperty('Style','Document');
+  CheckEquals('Document',f.GetPropertyManager().GetProperty('Style'),'Style');
+  strm := TStringStream.Create(VAL_STREAM);
+  try
+    strm.Position := 0;
+    f.LoadFromStream(strm);
+    try
+      f.BeginCallRead(nil);
+      Check(False,'BeginCallRead() should raise an exception.');
+    except
+      on e : ESOAPException do begin
+        excpt_code := e.FaultCode;
+        excpt_msg := e.FaultString;
+      end;
+    end;
+    CheckEquals(VAL_CODE,excpt_code,'faultCode');
+    CheckEquals(VAL_MSG,excpt_msg,'faultString');
+    CheckEquals('Document',f.GetPropertyManager().GetProperty('Style'),'Style');
+    
+    f := CreateFormatterClient();
+    f.GetPropertyManager().SetProperty('Style','RPC');
+    CheckEquals('RPC',f.GetPropertyManager().GetProperty('Style'),'Style');
+    strm.Position := 0;
+    f.LoadFromStream(strm);
+    try
+      f.BeginCallRead(nil);
+      Check(False,'BeginCallRead() should raise an exception.');
+    except
+      on e : ESOAPException do begin
+        excpt_code := e.FaultCode;
+        excpt_msg := e.FaultString;
+      end;
+    end;
+    CheckEquals(VAL_CODE,excpt_code,'faultCode');
+    CheckEquals(VAL_MSG,excpt_msg,'faultString');
+    CheckEquals('RPC',f.GetPropertyManager().GetProperty('Style'),'Style');
+  finally
+    FreeAndNil(strm);
+  end;
+end;
+
 {$IFDEF WST_RECORD_RTTI}
 function __TTestSmallRecord_TYPEINFO_FUNC__() : PTypeInfo;
 var

wst/trunk/tests/test_suite/wst_test_suite_gui.lpi

@@ -34,12 +34,57 @@
         <PackageName Value="fpcunittestrunner"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="1">
+    <Units Count="10">
       <Unit0>
         <Filename Value="wst_test_suite_gui.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="wst_test_suite_gui"/>
       </Unit0>
+      <Unit1>
+        <Filename Value="test_support.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_support"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="test_utilities.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_utilities"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="testformatter_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testformatter_unit"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="test_generators.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_generators"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="testmetadata_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testmetadata_unit"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="test_parsers.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_parsers"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="test_basex_encode.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_basex_encode"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="test_json.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_json"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="test_suite_utils.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_suite_utils"/>
+      </Unit9>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

wst/trunk/tests/test_suite/wst_test_suite_gui.lpr

@@ -11,8 +11,8 @@ uses
   server_service_soap, soap_formatter, base_binary_formatter,
   base_service_intf, base_soap_formatter, binary_formatter, binary_streamer,
   server_binary_formatter, metadata_repository,
-  metadata_generator, parserdefs, server_service_intf, metadata_wsdl,
+  metadata_generator, server_service_intf, metadata_wsdl,
-  test_parserdef, base_xmlrpc_formatter, wst_fpc_xml, test_utilities,
+  base_xmlrpc_formatter, wst_fpc_xml, test_utilities,
   server_service_xmlrpc, test_parsers, wsdl_generator, xsd_generator,
   xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode,
   test_basex_encode, json_formatter, server_service_json, test_json,