Part 3 final

* simple content header block implementation : TSimpleContentHeaderBlock
  * XSD/WSDL generator tests : header, simple content header, collection

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@551 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2008-09-11 00:44:56 +00:00
parent bc4dd0ba39
commit a9871c2bc3
4 changed files with 467 additions and 3 deletions

View File

@ -36,6 +36,10 @@ type
procedure class_properties_default();
procedure class_properties_extended_metadata();
procedure class_extent_native_type();
procedure class_headerblock_derived();
procedure class_headerblock_simplecontent_derived();
procedure array_sequence_collection();
end;
TTest_XsdGenerator = class(TTest_CustomXsdGenerator)
@ -45,7 +49,8 @@ type
implementation
uses test_suite_utils;
uses
test_suite_utils, xsd_consts;
{ TTest_CustomXsdGenerator }
@ -254,6 +259,177 @@ begin
end;
end;
procedure TTest_CustomXsdGenerator.class_headerblock_derived();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
cltyp : TPasClassType;
procedure AddProperty(
const AName,
ATypeName,
ADefault : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0));
cltyp.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.DefaultValue := ADefault;
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'class_headerblock_derived',tr.Package,visDefault,'',0));
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleHeader',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('THeaderBlock',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty('intField','integer','',ptField);
AddProperty('strField','string','',ptField);
AddProperty('floatField','float','',ptField);
AddProperty('strAtt','string','',ptAttribute);
AddProperty('intAtt','integer','',ptAttribute);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'.\class_headerblock_derived.xsd');
locExistDoc := LoadXmlFromFilesList('class_headerblock_derived.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdGenerator.class_headerblock_simplecontent_derived();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
cltyp : TPasClassType;
procedure AddProperty(
const AName,
ATypeName,
ADefault : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0));
cltyp.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.DefaultValue := ADefault;
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'class_headerblock_simplecontent_derived',tr.Package,visDefault,'',0));
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleHeader',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TSimpleContentHeaderBlock',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty('strAtt','string','',ptAttribute);
AddProperty('intAtt','integer','',ptAttribute);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'.\class_headerblock_simplecontent_derived.xsd');
locExistDoc := LoadXmlFromFilesList('class_headerblock_simplecontent_derived.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdGenerator.array_sequence_collection();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
cltyp : TPasClassType;
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
arrayTyp : TPasArrayType;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'array_sequence_collection',tr.Package,visDefault,'',0));
tr.RegisterExternalAlias(mdl,'urn:wst-test');
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
arrayTyp := tr.CreateArray('TCollectionComplexType',cltyp,'field','field',asScoped);
tr.SetCollectionFlag(arrayTyp,True);
mdl.InterfaceSection.Declarations.Add(arrayTyp);
mdl.InterfaceSection.Types.Add(arrayTyp);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'array_sequence_collection.xsd');
locExistDoc := LoadXmlFromFilesList('array_sequence_collection.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
function TTest_CustomXsdGenerator.LoadXmlFromFilesList(const AFileName: string): TXMLDocument;
var
locFileName : string;

View File

@ -50,6 +50,9 @@ type
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;virtual;abstract;
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
published
procedure EmptySchema();
@ -72,6 +75,9 @@ type
procedure ComplexType_CollectionSequence();
procedure pascal_class_default_parent();
procedure class_headerblock_derived();
procedure class_headerblock_simplecontent_derived();
end;
{ TTest_XsdParser }
@ -102,6 +108,9 @@ type
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override;
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
end;
{ TTest_WsdlParser }
@ -132,6 +141,9 @@ type
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override;
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
published
procedure no_binding_style();
procedure signature_last();
@ -1159,6 +1171,56 @@ begin
end;
end;
procedure TTest_CustomXsdParser.class_headerblock_derived();
const s_class_name = 'TSampleHeader';
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
clsType : TPasClassType;
elt : TPasElement;
begin
tr := load_class_headerblock_derived_Schema();
try
mdl := tr.FindModule('class_headerblock_derived');
CheckNotNull(mdl,'class_headerblock_derived');
elt := tr.FindElement(s_class_name);
CheckNotNull(elt,s_class_name);
CheckEquals(s_class_name,elt.Name);
CheckEquals(s_class_name,tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckNotNull(clsType.AncestorType,'AncestorType is null');
CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType);
finally
tr.Free();
end;
end;
procedure TTest_CustomXsdParser.class_headerblock_simplecontent_derived();
const s_class_name = 'TSampleHeader';
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
clsType : TPasClassType;
elt : TPasElement;
begin
tr := load_class_headerblock_simplecontent_derived_Schema();
try
mdl := tr.FindModule('class_headerblock_simplecontent_derived');
CheckNotNull(mdl,'class_headerblock_simplecontent_derived');
elt := tr.FindElement(s_class_name);
CheckNotNull(elt,s_class_name);
CheckEquals(s_class_name,elt.Name);
CheckEquals(s_class_name,tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckNotNull(clsType.AncestorType,'AncestorType is null');
CheckSame(tr.FindElementNS('TSimpleContentHeaderBlock',sXSD_NS),clsType.AncestorType,'AncestorType');
finally
tr.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_default_values();
var
tr : TwstPasTreeContainer;
@ -1388,6 +1450,16 @@ begin
Result := ParseDoc('pascal_class_parent');
end;
function TTest_XsdParser.load_class_headerblock_derived_Schema() : TwstPasTreeContainer;
begin
Result := ParseDoc('class_headerblock_derived');
end;
function TTest_XsdParser.load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;
begin
Result := ParseDoc('class_headerblock_simplecontent_derived');
end;
function TTest_XsdParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_class_default);
@ -1491,6 +1563,16 @@ begin
Result := ParseDoc('pascal_class_parent');
end;
function TTest_WsdlParser.load_class_headerblock_derived_Schema( ) : TwstPasTreeContainer;
begin
Result := ParseDoc('class_headerblock_derived');
end;
function TTest_WsdlParser.load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;
begin
Result := ParseDoc('class_headerblock_simplecontent_derived');
end;
procedure TTest_WsdlParser.no_binding_style();
var
symTable : TwstPasTreeContainer;

View File

@ -101,6 +101,20 @@ type
property Prop_B : TNameSpaceB_Class read FProp_B write FProp_B;
end;
TSampleSimpleContentHeaderBlock_A = class(TSimpleContentHeaderBlock)
public
class function GetNameSpace() : string;
end;
{ TSampleSimpleContentHeaderBlock_B }
TSampleSimpleContentHeaderBlock_B = class(TSampleSimpleContentHeaderBlock_A)
private
FintAtt : Integer;
published
property intAtt : Integer read FintAtt write FintAtt;
end;
{ TTest_SoapFormatterServerNameSpace }
TTest_SoapFormatterServerNameSpace = class(TTestCase)
@ -111,9 +125,19 @@ type
procedure multi_namespace_object_read();
end;
{ TTest_SoapFormatterHeader }
TTest_SoapFormatterHeader = class(TTestCase)
published
procedure write_header_simple_content_1();
procedure write_header_simple_content_2();
procedure read_header_simple_content_1();
procedure read_header_simple_content_2();
end;
implementation
uses
object_serializer, server_service_soap, test_suite_utils;
object_serializer, server_service_soap, test_suite_utils, soap_formatter;
function GetFileFullName(const AFileName: string): string;
begin
@ -412,7 +436,188 @@ begin
Result := 'NameSpace.C';
end;
{ TSampleSimpleContentHeaderBlock_A }
class function TSampleSimpleContentHeaderBlock_A.GetNameSpace() : string;
begin
Result := 'urn:simple-content-header.sample';
end;
{ TTest_SoapFormatterHeader }
procedure TTest_SoapFormatterHeader.write_header_simple_content_1();
var
ser : IFormatterClient;
cc : ICallContext;
hdr : TSampleSimpleContentHeaderBlock_A;
locStream : TMemoryStream;
locDoc, locExistDoc : TXMLDocument;
begin
cc := TSimpleCallContext.Create();
hdr := TSampleSimpleContentHeaderBlock_A.Create();
cc.AddHeader(hdr,True);
hdr.Direction := hdOut;
hdr.Value := 'sample header simple content value';
ser := soap_formatter.TSOAPFormatter.Create();
ser.BeginCall('test_proc','TestService',cc);
ser.EndScope();
locDoc := nil;
locExistDoc := nil;
locStream := TMemoryStream.Create();
try
ser.SaveToStream(locStream);
locStream.SaveToFile(wstExpandLocalFileName('write_header_simple_content_1.xml'));
locStream.Position := 0;
ReadXMLFile(locDoc,locStream);
ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'write_header_simple_content_1.xml'));
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locDoc);
ReleaseDomNode(locExistDoc);
locStream.Free();
end;
end;
procedure TTest_SoapFormatterHeader.write_header_simple_content_2();
var
ser : IFormatterClient;
cc : ICallContext;
hdrA : TSampleSimpleContentHeaderBlock_A;
hdrB : TSampleSimpleContentHeaderBlock_B;
locStream : TMemoryStream;
locDoc, locExistDoc : TXMLDocument;
begin
cc := TSimpleCallContext.Create();
hdrA := TSampleSimpleContentHeaderBlock_A.Create();
cc.AddHeader(hdrA,True);
hdrA.Direction := hdOut;
hdrA.Value := 'sample header simple content value';
hdrB := TSampleSimpleContentHeaderBlock_B.Create();
cc.AddHeader(hdrB,True);
hdrB.Direction := hdOut;
hdrB.Value := 'another content';
hdrB.intAtt := 1210;
ser := soap_formatter.TSOAPFormatter.Create();
ser.BeginCall('test_proc','TestService',cc);
ser.EndScope();
locDoc := nil;
locExistDoc := nil;
locStream := TMemoryStream.Create();
try
ser.SaveToStream(locStream);
locStream.SaveToFile(wstExpandLocalFileName('write_header_simple_content_2.xml'));
locStream.Position := 0;
ReadXMLFile(locDoc,locStream);
ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'write_header_simple_content_2.xml'));
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locDoc);
ReleaseDomNode(locExistDoc);
locStream.Free();
end;
end;
procedure TTest_SoapFormatterHeader.read_header_simple_content_1();
const
XML_SOURCE =
'<?xml version="1.0"?>' + sLineBreak +
'<SOAP-ENV:Envelope ' + sLineBreak +
' xmlns:xsd="http://www.w3.org/2001/XMLSchema" ' + sLineBreak +
' xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" ' + sLineBreak +
' xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" ' + sLineBreak +
' xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">' + sLineBreak +
' <SOAP-ENV:Header xmlns:ns1="urn:simple-content-header.sample">' + sLineBreak +
' <ns1:TSampleSimpleContentHeaderBlock_A SOAP-ENV:mustUnderstand="1">sample header simple content value</ns1:TSampleSimpleContentHeaderBlock_A>' + sLineBreak +
' </SOAP-ENV:Header>' + sLineBreak +
' <SOAP-ENV:Body>' + sLineBreak +
' <ns2:test_proc xmlns:ns2="TestService"/>' + sLineBreak +
' </SOAP-ENV:Body>' + sLineBreak +
'</SOAP-ENV:Envelope>';
var
f : IFormatterClient;
strm : TMemoryStream;
strBuffer : ansistring;
cctx : ICallContext;
hdr : TSampleSimpleContentHeaderBlock_A;
begin
f := soap_formatter.TSOAPFormatter.Create() as IFormatterClient;
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),TSampleSimpleContentHeaderBlock_A);
hdr := TSampleSimpleContentHeaderBlock_A(cctx.GetHeader(0));
CheckEquals(1,hdr.mustUnderstand,'mustUnderstand');
CheckEquals('sample header simple content value',hdr.Value,'Value');
f.EndScopeRead();
finally
FreeAndNil(strm);
end;
end;
procedure TTest_SoapFormatterHeader.read_header_simple_content_2();
const
XML_SOURCE =
'<?xml version="1.0"?>' + sLineBreak +
'<SOAP-ENV:Envelope ' + sLineBreak +
' xmlns:xsd="http://www.w3.org/2001/XMLSchema" ' + sLineBreak +
' xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" ' + sLineBreak +
' xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" ' + sLineBreak +
' xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">' + sLineBreak +
' <SOAP-ENV:Header xmlns:ns1="urn:simple-content-header.sample">' + sLineBreak +
' <ns1:TSampleSimpleContentHeaderBlock_A SOAP-ENV:mustUnderstand="1">sample header simple content value</ns1:TSampleSimpleContentHeaderBlock_A>' + sLineBreak +
' <ns1:TSampleSimpleContentHeaderBlock_B ns1:intAtt="1210" SOAP-ENV:mustUnderstand="0">another content</ns1:TSampleSimpleContentHeaderBlock_B>' + sLineBreak +
' </SOAP-ENV:Header>' + sLineBreak +
' <SOAP-ENV:Body>' + sLineBreak +
' <ns2:test_proc xmlns:ns2="TestService"/>' + sLineBreak +
' </SOAP-ENV:Body>' + sLineBreak +
'</SOAP-ENV:Envelope>';
var
f : IFormatterClient;
strm : TMemoryStream;
strBuffer : ansistring;
cctx : ICallContext;
hdrA : TSampleSimpleContentHeaderBlock_A;
hdrB : TSampleSimpleContentHeaderBlock_B;
begin
f := soap_formatter.TSOAPFormatter.Create() as IFormatterClient;
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(2,cctx.GetHeaderCount([hdIn]),'Input header count');
CheckIs(cctx.GetHeader(0),TSampleSimpleContentHeaderBlock_A);
hdrA := TSampleSimpleContentHeaderBlock_A(cctx.GetHeader(0));
CheckEquals(1,hdrA.mustUnderstand,'mustUnderstand');
CheckEquals('sample header simple content value',hdrA.Value,'Value');
CheckIs(cctx.GetHeader(1),TSampleSimpleContentHeaderBlock_B);
hdrB := TSampleSimpleContentHeaderBlock_B(cctx.GetHeader(1));
CheckEquals(0,hdrB.mustUnderstand,'mustUnderstand');
CheckEquals('another content',hdrB.Value,'Value');
f.EndScopeRead();
finally
FreeAndNil(strm);
end;
end;
initialization
GetTypeRegistry().Register(TSampleSimpleContentHeaderBlock_A.GetNameSpace(),TypeInfo(TSampleSimpleContentHeaderBlock_A));
TSampleSimpleContentHeaderBlock_B.RegisterAttributeProperty('intAtt');
GetTypeRegistry().Register(TSampleSimpleContentHeaderBlock_B.GetNameSpace(),TypeInfo(TSampleSimpleContentHeaderBlock_B));
GetTypeRegistry().Register(NBHeader.GetNameSpace(),TypeInfo(NBHeader),'NBHeader');
GetTypeRegistry().Register(TNameSpaceA_Class.GetNameSpace(),TypeInfo(TNameSpaceA_Class));
GetTypeRegistry().Register(TNameSpaceB_Class.GetNameSpace(),TypeInfo(TNameSpaceB_Class));
@ -420,6 +625,7 @@ initialization
GetTypeRegistry().Register(ns_soap_test,TypeInfo(TSOAPTestEnum));
RegisterTest('Serializer',TTest_SoapFormatterServerNameSpace.Suite);
RegisterTest('Serializer',TTest_SoapFormatterHeader.Suite);
end.

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_registry, test_generators_runtime;
test_wst_cursors, test_registry, test_soap_specific, test_generators_runtime;
Const
ShortOpts = 'alh';