diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index a0271a8ff..15fc6d859 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 9acce164e..3a486f823 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/test_soap_specific.pas b/wst/trunk/tests/test_suite/test_soap_specific.pas index ab8dae422..7bc5afa34 100644 --- a/wst/trunk/tests/test_suite/test_soap_specific.pas +++ b/wst/trunk/tests/test_suite/test_soap_specific.pas @@ -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 = + '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' sample header simple content value' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +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 = + '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' sample header simple content value' + sLineBreak + + ' another content' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +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. diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index a110eb36a..dd59871d9 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -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';