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

Keep the Soap Style even after an exception

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@504 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-07-03 16:27:23 +00:00
parent e6599ad9f8
commit 2549456a52
4 changed files with 139 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
wst/trunk/soap_formatter.pas
View File

@ -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;

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

@ -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

47
wst/trunk/tests/test_suite/wst_test_suite_gui.lpi
View File

@ -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>

4
wst/trunk/tests/test_suite/wst_test_suite_gui.lpr
View File

@ -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,