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

+Serialization of compound element ( TBaseComplexRemotable ) is now handle by TObjectSerializer that can read/write elements of different name spaces

Browse Source 
+Fix server side SOAP headers reading.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@533 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-08-24 13:33:06 +00:00
parent d8690785ba
commit 7296df02a0
30 changed files with 2761 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr
View File

@ -23,7 +23,9 @@ uses
test_suite_utils in '..\test_suite_utils.pas',
test_std_cursors in '..\test_std_cursors.pas',
test_rtti_filter in '..\test_rtti_filter.pas',
test_wst_cursors in '..\test_wst_cursors.pas';
test_wst_cursors in '..\test_wst_cursors.pas',
test_registry in '..\test_registry.pas',
test_soap_specific in '..\test_soap_specific.pas';
{$R *.res}

1
wst/trunk/tests/test_suite/files/class_properties_default.xsd
View File

@ -1,3 +1,4 @@
<?xml version="1.0"?>
<schema targetNamespace="class_properties_default" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="class_properties_default">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>

42
wst/trunk/tests/test_suite/files/soap_multi_namespace_object.xml Normal file
View File

@ -0,0 +1,42 @@
<?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-ENC="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<ns1:SampleProcResponse xmlns:ns1="SampleService" xmlns:ns2="NameSpace.A" xmlns:ns3="NameSpace.B" xmlns:ns4="NameSpace.C">
<ns2:a>
<ns2:Qualified_Val_Bool>true</ns2:Qualified_Val_Bool>
<ns2:Qualified_Val_Enum>steTwo</ns2:Qualified_Val_Enum>
<ns2:Qualified_Val_Integer>1210</ns2:Qualified_Val_Integer>
<ns2:Qualified_Val_Int64>123456</ns2:Qualified_Val_Int64>
<ns2:Qualified_Val_String>sample string.</ns2:Qualified_Val_String>
</ns2:a>
<ns3:b>
<ns2:Qualified_Val_Bool>true</ns2:Qualified_Val_Bool>
<ns2:Qualified_Val_Enum>steThree</ns2:Qualified_Val_Enum>
<ns2:Qualified_Val_Integer>456</ns2:Qualified_Val_Integer>
<ns2:Qualified_Val_Int64>78945</ns2:Qualified_Val_Int64>
<ns2:Qualified_Val_String>Sample string inherited from TNameSpaceA_Class.</ns2:Qualified_Val_String>
<ns3:Val_Bool>true</ns3:Val_Bool>
<ns3:Val_String>WST sample string, local to NameSpace.B</ns3:Val_String>
</ns3:b>
<ns4:c>
<ns4:Prop_String>This property should be in : NameSpace.C</ns4:Prop_String>
<ns2:Prop_A>
<ns2:Qualified_Val_Bool>false</ns2:Qualified_Val_Bool>
<ns2:Qualified_Val_Enum>steOne</ns2:Qualified_Val_Enum>
<ns2:Qualified_Val_Integer>0</ns2:Qualified_Val_Integer>
<ns2:Qualified_Val_Int64>0</ns2:Qualified_Val_Int64>
<ns2:Qualified_Val_String>This property should be in : NameSpace.A</ns2:Qualified_Val_String>
</ns2:Prop_A>
<ns3:Prop_B>
<ns2:Qualified_Val_Bool>false</ns2:Qualified_Val_Bool>
<ns2:Qualified_Val_Enum>steFour</ns2:Qualified_Val_Enum>
<ns2:Qualified_Val_Integer>789</ns2:Qualified_Val_Integer>
<ns2:Qualified_Val_Int64>64</ns2:Qualified_Val_Int64>
<ns2:Qualified_Val_String>This inherited property should be in : NameSpace.A</ns2:Qualified_Val_String>
<ns3:Val_Bool>true</ns3:Val_Bool>
<ns3:Val_String>local elemet. This property should be in : NameSpace.B</ns3:Val_String>
</ns3:Prop_B>
</ns4:c>
</ns1:SampleProcResponse>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>

4
wst/trunk/tests/test_suite/test_generators.pas
View File

@ -105,7 +105,7 @@ begin
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'.\class_properties_default.xsd');
locExistDoc := LoadXmlFromFilesList('class_properties_default.xsd');
Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
@ -246,7 +246,7 @@ begin
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'.\class_extent_native_type.xsd');
locExistDoc := LoadXmlFromFilesList('class_extent_native_type.xsd');
Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);

2
wst/trunk/tests/test_suite/test_json.pas
View File

@ -101,7 +101,7 @@ var
strm : TMemoryStream;
locParser : TJSONParser;
root, errorNodeObj : TJSONObject;
errorNode, tmpNode : TJSONData;
errorNode : TJSONData;
excpt_code, excpt_msg : string;
begin
root := nil;

178
wst/trunk/tests/test_suite/test_registry.pas Normal file
View File

@ -0,0 +1,178 @@
{ This file is part of the Web Service Toolkit
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit test_registry;
interface
uses
Classes, SysUtils,
{$IFDEF FPC}
fpcunit, testregistry,
{$ELSE}
TestFrameWork,
{$ENDIF}
TypInfo,
wst_types, base_service_intf;
const
s_sample_namespace = 'org.wst.sample';
type
{ TClass_A }
TClass_A = class(TBaseComplexRemotable)
private
FIntProp : Integer;
FStrProp : string;
published
// StrProp is an attribute property in this class !
property StrProp : string read FStrProp write FStrProp;
property IntProp : Integer read FIntProp write FIntProp;
end;
{ TClass_B }
TClass_B = class(TBaseComplexRemotable)
private
FIntProp : Integer;
FStrProp : string;
published
property StrProp : string read FStrProp write FStrProp;
property IntProp : Integer read FIntProp write FIntProp;
end;
TClass_C = class(TBaseComplexRemotable)
private
FIntProp : Integer;
FStrProp : string;
published
property StrProp : string read FStrProp write FStrProp;
//IntProp is an attribute property
property IntProp : Integer read FIntProp write FIntProp;
end;
{ TTest_TTypeRegistry }
TTest_TTypeRegistry = class(TTestCase)
protected
published
procedure Register();
procedure Register_with_declared_name();
procedure isAttributeProperty();
procedure register_external_prop();
procedure synonym_procs();
end;
implementation
{ TTest_TTypeRegistry }
procedure TTest_TTypeRegistry.Register();
var
reg : TTypeRegistry;
regItem0 : TTypeRegistryItem;
c : PtrInt;
begin
reg := TTypeRegistry.Create();
try
CheckEquals(0, reg.Count, 'Count');
c := reg.Count;
regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
CheckEquals( ( c + 1 ), reg.Count, 'Count');
CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True));
CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]);
Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType');
CheckEquals(TClass_A.ClassName,regItem0.DeclaredName);
CheckEquals(s_sample_namespace,regItem0.NameSpace);
finally
reg.Free();
end;
end;
procedure TTest_TTypeRegistry.Register_with_declared_name();
const s_declared_name = 'sample_declared_name';
var
reg : TTypeRegistry;
regItem0 : TTypeRegistryItem;
c : PtrInt;
begin
reg := TTypeRegistry.Create();
try
CheckEquals(0, reg.Count, 'Count');
c := reg.Count;
regItem0 := reg.Register(s_sample_namespace,TypeInfo(TClass_A),s_declared_name);
CheckEquals( ( c + 1 ), reg.Count, 'Count');
CheckSame(regItem0,reg.Find(TypeInfo(TClass_A),True));
CheckSame(regItem0,reg.ItemByTypeInfo[TypeInfo(TClass_A)]);
Check(regItem0.DataType = TypeInfo(TClass_A),'Item.DataType');
CheckEquals(s_declared_name,regItem0.DeclaredName);
CheckEquals(s_sample_namespace,regItem0.NameSpace);
finally
reg.Free();
end;
end;
procedure TTest_TTypeRegistry.isAttributeProperty();
begin
Check(TClass_A.IsAttributeProperty('StrProp'));
Check(not TClass_A.IsAttributeProperty('IntProp'));
Check(not TClass_B.IsAttributeProperty('StrProp'));
Check(TClass_C.IsAttributeProperty('IntProp'));
Check(not TClass_C.IsAttributeProperty('StrProp'));
end;
procedure TTest_TTypeRegistry.register_external_prop();
const s_ext_name = 'sample_external_name';
var
reg : TTypeRegistry;
regItem : TTypeRegistryItem;
begin
reg := TTypeRegistry.Create();
try
regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
regItem.RegisterExternalPropertyName('StrProp',s_ext_name);
CheckEquals(s_ext_name,regItem.GetExternalPropertyName('StrProp'));
CheckEquals('StrProp',regItem.GetInternalPropertyName(s_ext_name));
finally
reg.Free();
end;
end;
procedure TTest_TTypeRegistry.synonym_procs();
const s_ext_name = 'sample_external_name';
var
reg : TTypeRegistry;
regItem : TTypeRegistryItem;
begin
reg := TTypeRegistry.Create();
try
regItem := reg.Register(s_sample_namespace,TypeInfo(TClass_A));
regItem.AddPascalSynonym(s_ext_name);
Check(regItem.IsSynonym(s_ext_name));
CheckSame(regItem, reg.Find(s_ext_name));
finally
reg.Free();
end;
end;
initialization
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_A));
TClass_A.RegisterAttributeProperty('StrProp');
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_B));
GetTypeRegistry().Register(s_sample_namespace,TypeInfo(TClass_C));
TClass_C.RegisterAttributeProperty('IntProp');
RegisterTest('Registry',TTest_TTypeRegistry.Suite);
end.

427
wst/trunk/tests/test_suite/test_soap_specific.pas Normal file
View File

@ -0,0 +1,427 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit test_soap_specific;
interface
uses
Classes, SysUtils,
{$IFDEF FPC}
fpcunit, testutils, testregistry, DOM, XmlRead, XmlWrite, wst_fpc_xml,
{$ENDIF}
{$IFNDEF FPC}
TestFrameWork, ActiveX, wst_delphi_xml,
{$ENDIF}
TypInfo,
base_service_intf, wst_types, server_service_intf, service_intf;
const
ns_soap_test = 'soap.test.namespace';
type
TSOAPTestEnum = ( steOne, steTwo, steThree, steFour );
{ NBHeader }
NBHeader = class(THeaderBlock)
private
FSessionID : string;
FUserID : string;
public
class procedure Load(
var AObject : TObject;
AStore : IFormatterBase;
var AName : string;
const ATypeInfo : PTypeInfo
);override;
class function GetNameSpace() : string;
published
property UserID : string read FUserID write FUserID;
property SessionID : string read FSessionID write FSessionID;
end;
{ TNameSpaceA_Class }
TNameSpaceA_Class = class(TBaseComplexRemotable)
private
FQualified_Val_Bool : boolean;
FQualified_Val_Enum : TSOAPTestEnum;
FQualified_Val_Int64 : Integer;
FQualified_Val_Integer : Integer;
FQualified_Val_String : string;
public
class function GetNameSpace() : string;virtual;
published
property Qualified_Val_Bool : boolean read FQualified_Val_Bool write FQualified_Val_Bool;
property Qualified_Val_Enum : TSOAPTestEnum read FQualified_Val_Enum write FQualified_Val_Enum;
property Qualified_Val_Integer : Integer read FQualified_Val_Integer write FQualified_Val_Integer;
property Qualified_Val_Int64 : Integer read FQualified_Val_Int64 write FQualified_Val_Int64;
property Qualified_Val_String : string Read FQualified_Val_String Write FQualified_Val_String;
end;
{ TNameSpaceB_Class }
TNameSpaceB_Class = class(TNameSpaceA_Class)
private
FVal_Bool : Boolean;
FVal_String : string;
public
class function GetNameSpace() : string;override;
published
property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool;
property Val_String : string Read FVal_String Write FVal_String;
end;
{ TNameSpaceC_Class }
TNameSpaceC_Class = class(TBaseComplexRemotable)
private
FProp_A : TNameSpaceA_Class;
FProp_B : TNameSpaceB_Class;
FProp_String : string;
public
constructor Create();override;
destructor Destroy();override;
class function GetNameSpace() : string;virtual;
published
property Prop_String : string Read FProp_String Write FProp_String;
property Prop_A : TNameSpaceA_Class read FProp_A write FProp_A;
property Prop_B : TNameSpaceB_Class read FProp_B write FProp_B;
end;
{ TTest_SoapFormatterServerNameSpace }
TTest_SoapFormatterServerNameSpace = class(TTestCase)
published
procedure namespace_declared_env();
procedure received_header();
procedure multi_namespace_object_write();
procedure multi_namespace_object_read();
end;
implementation
uses
object_serializer, server_service_soap, test_suite_utils;
function GetFileFullName(const AFileName: string): string;
var
locFileName : string;
begin
{$IFDEF FPC}
Result := Format('.%sfiles%s%s',[PathDelim,PathDelim,AFileName]);
{$ENDIF}
{$IFDEF DELPHI}
Result := Format('..%sfiles%s%s',[PathDelim,PathDelim,AFileName]);
{$ENDIF}
end;
function LoadXmlFromFilesList(const AFileName: string): TXMLDocument;
begin
ReadXMLFile(Result,GetFileFullName(AFileName));
end;
{ NBHeader }
class procedure NBHeader.Load(
var AObject : TObject;
AStore : IFormatterBase;
var AName : string;
const ATypeInfo : PTypeInfo
);
var
locSerializer : TObjectSerializer;
begin
locSerializer := TObjectSerializer.Create(Self,GetTypeRegistry());
try
locSerializer.Read(AObject,AStore,AName,ATypeInfo);
finally
locSerializer.Free();
end;
end;
class function NBHeader.GetNameSpace() : string;
begin
Result := 'NBS3';
end;
{ TTest_SoapFormatterServerNameSpace }
procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env();
const
XML_SOURCE =
'<soapenv:Envelope ' + sLineBreak +
'xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" ' + sLineBreak +
'xmlns:hfp="hfpax"> ' + sLineBreak +
' <soapenv:Header/> ' + sLineBreak +
' <soapenv:Body> ' + sLineBreak +
' <hfp:GetVersion/> ' + sLineBreak +
' </soapenv:Body> ' + sLineBreak +
'</soapenv:Envelope>';
var
f : IFormatterResponse;
strm : TMemoryStream;
strBuffer : ansistring;
cctx : ICallContext;
begin
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
strm := TMemoryStream.Create();
try
strBuffer := XML_SOURCE;
strm.Write(strBuffer[1],Length(strBuffer));
strm.Position := 0;
f.LoadFromStream(strm);
cctx := TSimpleCallContext.Create() as ICallContext;
f.BeginCallRead(cctx);
strBuffer := f.GetCallProcedureName();
CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()');
f.EndScopeRead();
finally
FreeAndNil(strm);
end;
end;
procedure TTest_SoapFormatterServerNameSpace.received_header();
const
XML_SOURCE =
'<?xml version="1.0" encoding="utf-8" ?>' + sLineBreak +
'<env:Envelope xmlns:xsd="http://www.w3.org/2001/XMLSchema"' + sLineBreak +
' xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"' + sLineBreak +
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">' + sLineBreak +
' <env:Header >' + sLineBreak +
' <n1:NBHeader xmlns:n1="NBS3"' + sLineBreak +
' env:mustUnderstand="1">' + sLineBreak +
' <n1:UserID>AL00287DE</n1:UserID>' + sLineBreak +
' <n1:SessionID>KvyxXkK9PAta4zLtm6PA</n1:SessionID>' + sLineBreak +
' </n1:NBHeader>' + sLineBreak +
' </env:Header>' + sLineBreak +
' <env:Body>' + sLineBreak +
' <n2:getSelbst xmlns:n2="NBS3">' + sLineBreak +
' </n2:getSelbst>' + sLineBreak +
' </env:Body>' + sLineBreak +
'</env:Envelope>';
var
f : IFormatterResponse;
strm : TMemoryStream;
strBuffer : ansistring;
cctx : ICallContext;
hdr : NBHeader;
begin
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
strm := TMemoryStream.Create();
try
strBuffer := XML_SOURCE;
strm.Write(strBuffer[1],Length(strBuffer));
strm.Position := 0;
f.LoadFromStream(strm);
cctx := TSimpleCallContext.Create() as ICallContext;
f.BeginCallRead(cctx);
CheckEquals(0,cctx.GetHeaderCount([hdOut]),'Ouput header count');
CheckEquals(1,cctx.GetHeaderCount([hdIn]),'Input header count');
CheckIs(cctx.GetHeader(0),NBHeader);
hdr := NBHeader(cctx.GetHeader(0));
CheckEquals(1,hdr.mustUnderstand,'mustUnderstand');
CheckEquals('AL00287DE',hdr.UserID,'UserID');
CheckEquals('KvyxXkK9PAta4zLtm6PA',hdr.SessionID);
strBuffer := f.GetCallProcedureName();
CheckEquals('getSelbst',strBuffer, 'GetCallProcedureName()');
f.EndScopeRead();
finally
FreeAndNil(strm);
end;
end;
procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_write();
var
f : IFormatterResponse;
strm : TMemoryStream;
a : TNameSpaceA_Class;
b : TNameSpaceB_Class;
c : TNameSpaceC_Class;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
c := nil;
b := nil;
strm := nil;
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
f.GetPropertyManager().SetProperty('Style','Document');
f.GetPropertyManager().SetProperty('EncodingStyle','Literal');
a := TNameSpaceA_Class.Create();
try
a.Qualified_Val_Bool := True;
a.Qualified_Val_Enum := steTwo;
a.Qualified_Val_Integer := 1210;
a.Qualified_Val_Int64 := 123456;
a.Qualified_Val_String := 'sample string.';
b := TNameSpaceB_Class.Create();
b.Val_Bool := True;
b.Val_String := 'WST sample string, local to ' + b.GetNameSpace();
b.Qualified_Val_Bool := True;
b.Qualified_Val_Enum := steThree;
b.Qualified_Val_Integer := 456;
b.Qualified_Val_Int64 := 78945;
b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.';
c := TNameSpaceC_Class.Create();
c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ;
c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ;
c.Prop_B.Val_Bool := True;
c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ;
c.Prop_B.Qualified_Val_Bool := False;
c.Prop_B.Qualified_Val_Enum := steFour;
c.Prop_B.Qualified_Val_Integer := 789;
c.Prop_B.Qualified_Val_Int64 := 64;
c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ;
f.BeginCallResponse('SampleProc','SampleService');
f.Put('a',TypeInfo(TNameSpaceA_Class),a);
f.Put('b',TypeInfo(TNameSpaceB_Class),b);
f.Put('c',TypeInfo(TNameSpaceC_Class),c);
f.EndCallResponse();
strm := TMemoryStream.Create();
f.SaveToStream(strm);
strm.SaveToFile('soap_multi_namespace_object.xml');
strm.Position := 0;
ReadXMLFile(locDoc,strm);
locExistDoc := LoadXmlFromFilesList('soap_multi_namespace_object.xml');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
c.Free();
b.Free();
a.Free();
strm.Free();
end;
end;
procedure TTest_SoapFormatterServerNameSpace.multi_namespace_object_read();
var
f : IFormatterResponse;
strm : TMemoryStream;
a, a_readed : TNameSpaceA_Class;
b, b_readed : TNameSpaceB_Class;
c, c_readed : TNameSpaceC_Class;
locDoc, locExistDoc : TXMLDocument;
strName : string;
begin
locDoc := nil;
locExistDoc := nil;
c := nil;
b := nil;
strm := nil;
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
f.GetPropertyManager().SetProperty('Style','Document');
f.GetPropertyManager().SetProperty('EncodingStyle','Literal');
a := TNameSpaceA_Class.Create();
try
a.Qualified_Val_Bool := True;
a.Qualified_Val_Enum := steTwo;
a.Qualified_Val_Integer := 1210;
a.Qualified_Val_Int64 := 123456;
a.Qualified_Val_String := 'sample string.';
b := TNameSpaceB_Class.Create();
b.Val_Bool := True;
b.Val_String := 'WST sample string, local to ' + b.GetNameSpace();
b.Qualified_Val_Bool := True;
b.Qualified_Val_Enum := steThree;
b.Qualified_Val_Integer := 456;
b.Qualified_Val_Int64 := 78945;
b.Qualified_Val_String := 'Sample string inherited from TNameSpaceA_Class.';
c := TNameSpaceC_Class.Create();
c.Prop_String := 'This property should be in : ' + c.GetNameSpace() ;
c.Prop_A.Qualified_Val_String := 'This property should be in : ' + a.GetNameSpace() ;
c.Prop_B.Val_Bool := True;
c.Prop_B.Val_String := 'local elemet. This property should be in : ' + b.GetNameSpace() ;
c.Prop_B.Qualified_Val_Bool := False;
c.Prop_B.Qualified_Val_Enum := steFour;
c.Prop_B.Qualified_Val_Integer := 789;
c.Prop_B.Qualified_Val_Int64 := 64;
c.Prop_B.Qualified_Val_String := 'This inherited property should be in : ' + a.GetNameSpace() ;
strm := TMemoryStream.Create();
strm.LoadFromFile(GetFileFullName('soap_multi_namespace_object.xml'));
strm.Position := 0;
f.LoadFromStream(strm);
a_readed := TNameSpaceA_Class.Create();
b_readed := TNameSpaceB_Class.Create();
c_readed := TNameSpaceC_Class.Create();
f.BeginCallRead(TSimpleCallContext.Create());
strName := 'a';
f.Get(TypeInfo(TNameSpaceA_Class),strName,a_readed);
strName := 'b';
f.Get(TypeInfo(TNameSpaceB_Class),strName,b_readed);
strName := 'c';
f.Get(TypeInfo(TNameSpaceC_Class),strName,c_readed);
f.EndScopeRead();
Check(a.Equal(a_readed) and a_readed.Equal(a),'a');
Check(b.Equal(b_readed) and b_readed.Equal(b),'b');
Check(c.Equal(c_readed) and c_readed.Equal(c),'c');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
c.Free();
b.Free();
a.Free();
strm.Free();
end;
end;
{ TNameSpaceA_Class }
class function TNameSpaceA_Class.GetNameSpace() : string;
begin
Result := 'NameSpace.A';
end;
{ TNameSpaceB_Class }
class function TNameSpaceB_Class.GetNameSpace() : string;
begin
Result := 'NameSpace.B';
end;
{ TNameSpaceC_Class }
constructor TNameSpaceC_Class.Create();
begin
inherited Create();
FProp_A := TNameSpaceA_Class.Create();
FProp_B := TNameSpaceB_Class.Create();
end;
destructor TNameSpaceC_Class.Destroy();
begin
FreeAndNil(FProp_B);
FreeAndNil(FProp_A);
inherited Destroy();
end;
class function TNameSpaceC_Class.GetNameSpace() : string;
begin
Result := 'NameSpace.C';
end;
initialization
GetTypeRegistry().Register(NBHeader.GetNameSpace(),TypeInfo(NBHeader),'NBHeader');
GetTypeRegistry().Register(TNameSpaceA_Class.GetNameSpace(),TypeInfo(TNameSpaceA_Class));
GetTypeRegistry().Register(TNameSpaceB_Class.GetNameSpace(),TypeInfo(TNameSpaceB_Class));
GetTypeRegistry().Register(TNameSpaceC_Class.GetNameSpace(),TypeInfo(TNameSpaceC_Class));
GetTypeRegistry().Register(ns_soap_test,TypeInfo(TSOAPTestEnum));
RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
end.

2
wst/trunk/tests/test_suite/test_suite_utils.pas
View File

@ -57,7 +57,7 @@ begin
Exit;
if ( A.Attributes.Length > 0 ) then begin
for i := 0 to Pred(A.Attributes.Length) do begin
if not CompareNodes(A.Attributes.Item[i],B.Attributes.Item[i]) then
if not CompareNodes(A.Attributes.Item[i],B.Attributes.GetNamedItem(A.Attributes.Item[i].NodeName)) then
Exit;
end;
end;

318
wst/trunk/tests/test_suite/test_support.pas
View File

@ -22,7 +22,7 @@ uses
TestFrameWork,
{$ENDIF}
TypInfo,
wst_types, base_service_intf;
wst_types, base_service_intf, imp_utils;
type
@ -352,6 +352,10 @@ type
procedure Equal();
procedure SetBinaryData();
procedure SetEncodedString();
procedure LoadFromStream();
procedure LoadFromFile();
procedure SaveToStream();
procedure SaveToFile();
end;
{ TTest_TBase64StringExtRemotable }
@ -362,6 +366,10 @@ type
procedure test_Assign();
procedure SetBinaryData();
procedure SetEncodedString();
procedure LoadFromStream();
procedure LoadFromFile();
procedure SaveToStream();
procedure SaveToFile();
end;
{ TClass_A_CollectionRemotable }
@ -389,6 +397,14 @@ type
procedure IndexOf();
end;
{ TTest_Procedures }
TTest_Procedures = class(TTestCase)
published
procedure test_LoadBufferFromStream();
procedure test_LoadBufferFromFile();
end;
implementation
uses Math, basex_encode;
@ -2171,7 +2187,6 @@ begin
end;
procedure TTest_TDateRemotable.ParseDate();
const sDATE = '1976-10-12T23:34:56';
var
s : string;
objd : TDateRemotable;
@ -2901,6 +2916,129 @@ begin
end;
end;
procedure TTest_TBase64StringRemotable.LoadFromStream();
var
locLoadedBuffer : TBase64StringRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locLoadedBuffer := nil;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locLoadedBuffer := TBase64StringRemotable.Create();
locLoadedBuffer.LoadFromStream(locStream);
Check( locLoadedBuffer.BinaryData = locBuffer );
finally
locLoadedBuffer.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringRemotable.LoadFromFile();
var
locLoadedBuffer : TBase64StringRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
locFileName : string;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locLoadedBuffer := nil;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locFileName := 'test_LoadBufferFromFile.bin';
locStream.SaveToFile(locFileName);
locLoadedBuffer := TBase64StringRemotable.Create();
locLoadedBuffer.LoadFromFile(locFileName);
Check( locLoadedBuffer.BinaryData = locBuffer );
finally
locLoadedBuffer.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringRemotable.SaveToStream();
var
locObj : TBase64StringRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locObj := nil;
locStream := TMemoryStream.Create();
try
locObj := TBase64StringRemotable.Create();
locObj.BinaryData := locBuffer;
locObj.SaveToStream(locStream);
Check( locStream.Size = Length(locObj.BinaryData) );
SetLength(locBuffer,locStream.Size);
locStream.Position := 0;
locStream.Read(locBuffer[1],Length(locBuffer));
Check( locBuffer = locObj.BinaryData );
finally
locObj.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringRemotable.SaveToFile();
var
locObj : TBase64StringRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TFileStream;
i : PtrInt;
locFileName : string;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locStream := nil;
locObj := TBase64StringRemotable.Create();
try
locObj.BinaryData := locBuffer;
locFileName := 'test_LoadBufferFromFile.bin';
DeleteFile(locFileName);
locObj.SaveToFile(locFileName);
Check(FileExists(locFileName));
locStream := TFileStream.Create(locFileName,fmOpenRead);
Check( locStream.Size = Length(locObj.BinaryData) );
SetLength(locBuffer,locStream.Size);
locStream.Position := 0;
locStream.Read(locBuffer[1],Length(locBuffer));
Check( locBuffer = locObj.BinaryData );
finally
locObj.Free();
locStream.Free();
end;
end;
{ TTest_TBase64StringExtRemotable }
procedure TTest_TBase64StringExtRemotable.Equal();
@ -2994,6 +3132,129 @@ begin
end;
end;
procedure TTest_TBase64StringExtRemotable.LoadFromStream();
var
locLoadedBuffer : TBase64StringExtRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locLoadedBuffer := nil;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locLoadedBuffer := TBase64StringExtRemotable.Create();
locLoadedBuffer.LoadFromStream(locStream);
Check( locLoadedBuffer.BinaryData = locBuffer );
finally
locLoadedBuffer.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringExtRemotable.LoadFromFile();
var
locLoadedBuffer : TBase64StringExtRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
locFileName : string;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locLoadedBuffer := nil;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locFileName := 'test_LoadBufferFromFile.bin';
locStream.SaveToFile(locFileName);
locLoadedBuffer := TBase64StringExtRemotable.Create();
locLoadedBuffer.LoadFromFile(locFileName);
Check( locLoadedBuffer.BinaryData = locBuffer );
finally
locLoadedBuffer.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringExtRemotable.SaveToStream();
var
locObj : TBase64StringExtRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locObj := nil;
locStream := TMemoryStream.Create();
try
locObj := TBase64StringExtRemotable.Create();
locObj.BinaryData := locBuffer;
locObj.SaveToStream(locStream);
Check( locStream.Size = Length(locObj.BinaryData) );
SetLength(locBuffer,locStream.Size);
locStream.Position := 0;
locStream.Read(locBuffer[1],Length(locBuffer));
Check( locBuffer = locObj.BinaryData );
finally
locObj.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringExtRemotable.SaveToFile();
var
locObj : TBase64StringExtRemotable;
locBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TFileStream;
i : PtrInt;
locFileName : string;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locStream := nil;
locObj := TBase64StringExtRemotable.Create();
try
locObj.BinaryData := locBuffer;
locFileName := 'test_LoadBufferFromFile.bin';
DeleteFile(locFileName);
locObj.SaveToFile(locFileName);
Check(FileExists(locFileName));
locStream := TFileStream.Create(locFileName,fmOpenRead);
Check( locStream.Size = Length(locObj.BinaryData) );
SetLength(locBuffer,locStream.Size);
locStream.Position := 0;
locStream.Read(locBuffer[1],Length(locBuffer));
Check( locBuffer = locObj.BinaryData );
finally
locObj.Free();
locStream.Free();
end;
end;
procedure TTest_TBase64StringExtRemotable.test_Assign();
const ITER = 100;
var
@ -3243,6 +3504,57 @@ begin
end;
end;
{ TTest_Procedures }
procedure TTest_Procedures.test_LoadBufferFromStream();
var
locBuffer, locLoadedBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locLoadedBuffer := LoadBufferFromStream(locStream);
Check( locLoadedBuffer = locBuffer );
finally
locStream.Free();
end;
end;
procedure TTest_Procedures.test_LoadBufferFromFile();
var
locBuffer, locLoadedBuffer : TBinaryString;
pBytePtr : PByte;
locStream : TMemoryStream;
i : PtrInt;
locFileName : string;
begin
SetLength(locBuffer,255);
pBytePtr := PByte(@(locBuffer[1]));
for i := 0 to 255 do begin
pBytePtr^ := i;
Inc(pBytePtr);
end;
locStream := TMemoryStream.Create();
try
locStream.Write(locBuffer[1],Length(locBuffer));
locFileName := 'test_LoadBufferFromFile.bin';
locStream.SaveToFile(locFileName);
locLoadedBuffer := LoadBufferFromFile(locFileName);
Check( locLoadedBuffer = locBuffer );
finally
locStream.Free();
end;
end;
initialization
RegisterTest('Support',TTest_TObjectCollectionRemotable.Suite);
RegisterTest('Support',TTest_TBaseComplexRemotable.Suite);
@ -3273,5 +3585,7 @@ initialization
RegisterTest('Support',TTest_TBase64StringRemotable.Suite);
RegisterTest('Support',TTest_TBase64StringExtRemotable.Suite);
RegisterTest('Support',TTest_Procedures.Suite);
end.

8
wst/trunk/tests/test_suite/test_wst_cursors.pas
View File

@ -4,7 +4,7 @@ unit test_wst_cursors;
interface
uses
Classes, SysUtils, Contnrs,
Classes, SysUtils,
{$IFDEF FPC}
fpcunit, testutils, testregistry,
{$ELSE}
@ -109,7 +109,7 @@ const O_COUNT = 100;
var
x : IObjectCursor;
ls : TBaseObjectArrayRemotable;
c, i : Integer;
i : Integer;
begin
ls := TTClass_A_ArrayRemotable.Create();
try
@ -182,7 +182,7 @@ const O_COUNT = 100;
var
x : IFilterableObjectCursor;
ls : TBaseObjectArrayRemotable;
c, i : Integer;
i : Integer;
f : IObjectFilter;
fcr : TRttiFilterCreator;
begin
@ -445,7 +445,7 @@ const O_COUNT = 100;
var
x : IObjectCursor;
ls : TObjectCollectionRemotable;
c, i : PtrInt;
i : PtrInt;
begin
ls := TTClass_A_CollectionRemotable.Create();
try

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

@ -517,14 +517,8 @@ type
published
procedure Assign();
end;
{ TTest_SoapFormatterServerNameSpace }
TTest_SoapFormatterServerNameSpace = class(TTestCase)
published
procedure namespace_declared_env();
end;
implementation
uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti,
Math, imp_utils
@ -537,7 +531,7 @@ uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_r
, server_service_soap, soap_formatter,
server_service_xmlrpc, xmlrpc_formatter,
binary_streamer, server_binary_formatter, binary_formatter,
test_suite_utils;
test_suite_utils, object_serializer;
function CompareNodes(const A,B : PDataBuffer) : Boolean;overload;forward;
@ -4245,41 +4239,9 @@ begin
end;
end;
{ TTest_SoapFormatterServerNameSpace }
procedure TTest_SoapFormatterServerNameSpace.namespace_declared_env();
const
XML_SOURCE =
'<soapenv:Envelope ' + sLineBreak +
'xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" ' + sLineBreak +
'xmlns:hfp="hfpax"> ' + sLineBreak +
' <soapenv:Header/> ' + sLineBreak +
' <soapenv:Body> ' + sLineBreak +
' <hfp:GetVersion/> ' + sLineBreak +
' </soapenv:Body> ' + sLineBreak +
'</soapenv:Envelope>';
var
f : IFormatterResponse;
strm : TMemoryStream;
strBuffer : ansistring;
cctx : ICallContext;
begin
f := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse;
strm := TMemoryStream.Create();
try
strBuffer := XML_SOURCE;
strm.Write(strBuffer[1],Length(strBuffer));
strm.Position := 0;
f.LoadFromStream(strm);
cctx := TSimpleCallContext.Create() as ICallContext;
f.BeginCallRead(cctx);
strBuffer := f.GetCallProcedureName();
CheckEquals('GetVersion',strBuffer, 'GetCallProcedureName()');
f.EndScopeRead();
finally
FreeAndNil(strm);
end;
end;
initialization
RegisterStdTypes();
@ -4345,5 +4307,5 @@ initialization
RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite);
RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite);
RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite);
RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
end.

2
wst/trunk/tests/test_suite/wst_test_suite.lpr
View File

@ -19,7 +19,7 @@ uses
xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode,
test_basex_encode, json_formatter, server_service_json, test_json,
test_suite_utils, test_generators, test_std_cursors, test_rtti_filter,
test_wst_cursors;
test_wst_cursors, test_registry;
Const
ShortOpts = 'alh';

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

@ -34,7 +34,7 @@
<PackageName Value="fpcunittestrunner"/>
</Item3>
</RequiredPackages>
<Units Count="16">
<Units Count="17">
<Unit0>
<Filename Value="wst_test_suite_gui.lpr"/>
<IsPartOfProject Value="True"/>
@ -111,10 +111,15 @@
<UnitName Value="test_wst_cursors"/>
</Unit14>
<Unit15>
<Filename Value="wst_collections.pas"/>
<Filename Value="test_registry.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_collections"/>
<UnitName Value="test_registry"/>
</Unit15>
<Unit16>
<Filename Value="test_soap_specific.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_soap_specific"/>
</Unit16>
</Units>
</ProjectOptions>
<CompilerOptions>

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

@ -17,7 +17,7 @@ uses
xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode,
test_basex_encode, json_formatter, server_service_json, test_json,
test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors,
test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors;
test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors, test_registry, test_soap_specific;
begin
Application.Initialize;