From 2549456a52954efa310e70b69c4a605b59973eff Mon Sep 17 00:00:00 2001 From: inoussa Date: Thu, 3 Jul 2008 16:27:23 +0000 Subject: [PATCH] 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 | 44 +++++++------ .../tests/test_suite/testformatter_unit.pas | 66 +++++++++++++++++++ .../tests/test_suite/wst_test_suite_gui.lpi | 47 ++++++++++++- .../tests/test_suite/wst_test_suite_gui.lpr | 4 +- 4 files changed, 139 insertions(+), 22 deletions(-) diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas index bb3c7dc5a..d56f53e2d 100644 --- a/wst/trunk/soap_formatter.pas +++ b/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; - PushStack(fltNd); - excpt_Obj := ESOAPException.Create(''); - Try - eltName := 'faultcode'; - Get(TypeInfo(string),eltName,msgBuff); - excpt_Obj.FaultCode := msgBuff; - eltName := 'faultstring'; - Get(TypeInfo(string),eltName,msgBuff); - excpt_Obj.FaultString := msgBuff; ; - excpt_Obj.Message := Format( - 'Service exception :%s Code = "%s"%s Message = "%s"', - [LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString] - ); - Except - FreeAndNil(excpt_Obj); - Raise; - End; - Raise excpt_Obj; + try + fltNd := bdyNd.FirstChild; + PushStack(fltNd); + excpt_Obj := ESOAPException.Create(''); + try + eltName := 'faultcode'; + Get(TypeInfo(string),eltName,msgBuff); + excpt_Obj.FaultCode := msgBuff; + eltName := 'faultstring'; + Get(TypeInfo(string),eltName,msgBuff); + excpt_Obj.FaultString := msgBuff; ; + excpt_Obj.Message := Format( + 'Service exception :%s Code = "%s"%s Message = "%s"', + [LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString] + ); + except + FreeAndNil(excpt_Obj); + raise; + end; + raise excpt_Obj; + finally + Self.Style := oldStyle; + end; End; end; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 507b47002..eb211f86e 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/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 = + ' '+ + ' ' + + ' '+ + ' '+ + ' ' + VAL_CODE + ' '+ + ' ' + VAL_MSG +' '+ + ' '+ + ' '+ + ' '; +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 diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi index 7d9b72a1b..f3616b423 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi @@ -34,12 +34,57 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr index 3c1ae0555..7f3dd6cc0 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr +++ b/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, - test_parserdef, base_xmlrpc_formatter, wst_fpc_xml, test_utilities, + metadata_generator, server_service_intf, metadata_wsdl, + 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,