From c8c6f3c94295bda8846a4dcf7bbfb7ac20bf1885 Mon Sep 17 00:00:00 2001 From: inoussa Date: Wed, 10 Sep 2008 01:19:04 +0000 Subject: [PATCH] Part 2 runtime WSDL generation : * class inheritance is handled correctly * record type handling * tests several warnings get fixed git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@542 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/metadata_wsdl.pas | 290 ++++++++++++++---- .../test_suite/delphi/gui_wst_test_suite.dpr | 3 +- .../test_suite/delphi/wst_test_suite.dpr | 7 +- .../test_suite/test_generators_runtime.pas | 265 ++++++++++++++++ wst/trunk/tests/test_suite/test_parsers.pas | 286 ++++++++++++++++- 5 files changed, 779 insertions(+), 72 deletions(-) create mode 100644 wst/trunk/tests/test_suite/test_generators_runtime.pas diff --git a/wst/trunk/metadata_wsdl.pas b/wst/trunk/metadata_wsdl.pas index ef1ab592d..9033a7cbf 100644 --- a/wst/trunk/metadata_wsdl.pas +++ b/wst/trunk/metadata_wsdl.pas @@ -13,6 +13,8 @@ {$INCLUDE wst_global.inc} unit metadata_wsdl; +{$RANGECHECKS OFF} + interface uses @@ -26,7 +28,8 @@ type ['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}'] procedure Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); end; @@ -49,7 +52,8 @@ type protected procedure Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); end; @@ -59,7 +63,8 @@ type protected procedure Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); end; @@ -69,23 +74,46 @@ type protected procedure Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); end; + { TRecord_TypeHandler } + + TRecord_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler) + protected + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry + ); + end; + + + procedure GenerateWSDL( + AMdtdRep : PServiceRepository; + ADoc : TXMLDocument; + ATypeRegistry : TTypeRegistry; + AHandlerRegistry : IWsdlTypeHandlerRegistry + );overload; procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);overload; function GenerateWSDL(const ARepName, ARootAddress : string):string;overload; function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; + function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry; + procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry); implementation uses wst_types -{$IFNDEF FPC} +{$IFDEF WST_DELPHI} , wst_delphi_rtti_utils -{$ELSE} +{$ENDIF} +{$IFDEF FPC} , wst_fpc_xml, XmlWrite -{$ENDIF}; +{$ENDIF} + , record_rtti; const sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/'; @@ -107,9 +135,11 @@ const sBASE = 'base'; sBINDING = 'binding'; sBODY = 'body'; + sCOMPLEX_CONTENT = 'complexContent'; sCOMPLEX_TYPE = 'complexType'; sELEMENT = 'element'; sENUMERATION = 'enumeration'; + sEXTENSION = 'extension'; sITEM = 'item'; sLOCATION = 'location'; sMIN_OCCURS = 'minOccurs'; @@ -125,6 +155,7 @@ const sTRANSPORT = 'transport'; sTYPE = 'type'; sUNBOUNDED = 'unbounded'; + sUSE = 'use'; sVALUE = 'value'; sWSDL_DEFINITIONS = 'definitions'; @@ -153,6 +184,7 @@ type TWsdlTypeHandlerRegistry = class(TBaseFactoryRegistry,IInterface,IWsdlTypeHandlerRegistry) private + FTypeRegistry : TTypeRegistry; FDefaultHandlerTable : Array[TTypeKind] of IItemFactory; private function FindNearestClass(const AClassType : TClass):IItemFactory; @@ -163,6 +195,7 @@ type AFactory : IItemFactory ); public + constructor Create(ATypeRegistry : TTypeRegistry); destructor Destroy();override; End; @@ -196,7 +229,7 @@ begin Result := nil; foundIndex := -1; score := MaxInt; - r := GetTypeRegistry(); + r := FTypeRegistry; c := Count; for i := 0 to Pred(c) do begin itm := Item[i]; @@ -223,7 +256,7 @@ begin Result := nil; fct := FindFactory(APascalTypeName); if not Assigned(fct) then begin - ri := GetTypeRegistry().Find(APascalTypeName); + ri := FTypeRegistry.Find(APascalTypeName); if Assigned(ri) then begin if ( ri.DataType^.Kind = tkClass ) then fct := FindNearestClass(GetTypeData(ri.DataType)^.ClassType); @@ -243,6 +276,13 @@ begin FDefaultHandlerTable[ATypeKind] := AFactory; end; +constructor TWsdlTypeHandlerRegistry.Create(ATypeRegistry : TTypeRegistry); +begin + Assert(ATypeRegistry <> nil); + inherited Create(); + FTypeRegistry := ATypeRegistry; +end; + destructor TWsdlTypeHandlerRegistry.Destroy(); var i : TTypeKind; @@ -292,13 +332,16 @@ end; function GetNameSpaceShortName( const ANameSpace : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + const APreferedShortName : string = '' ):string;//inline; begin if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); end else begin - Result := Format('ns%d',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ; + Result := Trim(APreferedShortName); + if ( Length(Result) = 0 ) then + Result := Format('ns%d',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ; AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace); end; end; @@ -311,7 +354,16 @@ begin end; procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument); +begin + GenerateWSDL(AMdtdRep,ADoc,GetTypeRegistry(),GetWsdlTypeHandlerRegistry()); +end; +procedure GenerateWSDL( + AMdtdRep : PServiceRepository; + ADoc : TXMLDocument; + ATypeRegistry : TTypeRegistry; + AHandlerRegistry : IWsdlTypeHandlerRegistry +); procedure GenerateServiceMessages( AService : PService; ARootNode : TDOMElement @@ -327,7 +379,7 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument); begin tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc); tmpNode.SetAttribute(sWSDL_NAME,APrm^.Name); - typItm := GetTypeRegistry().Find(APrm^.TypeName); + typItm := ATypeRegistry.Find(APrm^.TypeName); if not Assigned(typItm) then raise EMetadataException.CreateFmt('Type not registered : "%s".',[APrm^.TypeName]); //Assert(Assigned(typItm),APrm^.TypeName); @@ -495,8 +547,8 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument); g : IWsdlTypeHandler; gr : IWsdlTypeHandlerRegistry; begin - tr := GetTypeRegistry(); - gr := GetWsdlTypeHandlerRegistry(); + tr := ATypeRegistry; + gr := AHandlerRegistry; k := tr.Count; for j := 0 to Pred(k) do begin tri := tr[j]; @@ -505,7 +557,7 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument); then begin g := gr.Find(tri.DataType^.Name); if assigned(g) then - g.Generate(tri.DataType^.Name,ADoc); + g.Generate(tri.DataType^.Name,ADoc,tr); end; end; end; @@ -617,7 +669,8 @@ type protected procedure Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); end; @@ -625,12 +678,29 @@ type procedure TBaseComplexRemotable_TypeHandler.Generate( const APascalTypeName : string; - AWsdlDocument : TXMLDocument + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry ); + + function FindHighestRegisteredParent(AClass : TClass) : TTypeRegistryItem; + var + locRes : TTypeRegistryItem; + begin + locRes := nil; + if ( AClass <> nil ) and ( AClass.ClassParent <> nil ) then begin + locRes := ATypeRegistry.Find(PTypeInfo(AClass.ClassParent.ClassInfo),False); + end; + if ( locRes <> nil ) then begin + if ( GetTypeData(locRes.DataType)^.ClassType = TBaseComplexRemotable ) then + locRes := nil; + end; + Result := locRes; + end; + var typItm, propTypItm : TTypeRegistryItem; s, prop_ns_shortName : string; - defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, cplxContentNode, extNode : TDOMElement; i : Integer; propList : PPropList; propCount, propListLen : Integer; @@ -639,8 +709,10 @@ var objTypeData : PTypeData; clsTyp : TBaseComplexRemotableClass; attProp : Boolean; + parentRegItem : TTypeRegistryItem; + parentClss : TClass; begin - typItm := GetTypeRegistry().Find(APascalTypeName); + typItm := ATypeRegistry.Find(APascalTypeName); if Assigned(typItm) and ( typItm.DataType^.Kind = tkClass ) then begin @@ -649,46 +721,64 @@ begin Assert(Assigned(defTypesNode)); defSchemaNode := defTypesNode.FirstChild as TDOMElement; + objTypeData := GetTypeData(typItm.DataType); + clsTyp := TBaseComplexRemotableClass(objTypeData^.ClassType); + parentRegItem := FindHighestRegisteredParent(clsTyp); + if ( parentRegItem <> nil ) then + parentClss := GetTypeData(parentRegItem.DataType)^.ClassType + else + parentClss := nil; + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); - cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + cplxNode.SetAttribute(sNAME, typItm.DeclaredName); + extNode := cplxNode; + if ( parentClss <> nil ) then begin + if ( parentRegItem.NameSpace = typItm.NameSpace ) then begin + s := Format('%s:%s',[sTNS,parentRegItem.DeclaredName]); + end else begin + s := Format('%s:%s',[GetNameSpaceShortName(parentRegItem.NameSpace,AWsdlDocument),parentRegItem.DeclaredName]); + end; + cplxContentNode := CreateElement(Format('%s:%s',[sXSD,sCOMPLEX_CONTENT]),cplxNode,AWsdlDocument); + extNode := CreateElement(Format('%s:%s',[sXSD,sEXTENSION]),cplxContentNode,AWsdlDocument); + extNode.SetAttribute(sBASE,s); + end; - s := Format('%s:%s',[sXSD,sSEQUENCE]); - sqcNode := CreateElement(s,cplxNode,AWsdlDocument); - objTypeData := GetTypeData(typItm.DataType); - clsTyp := TBaseComplexRemotableClass(objTypeData^.ClassType); + sqcNode := CreateElement(Format('%s:%s',[sXSD,sSEQUENCE]),extNode,AWsdlDocument); propCount := objTypeData^.PropCount; if ( propCount > 0 ) then begin propListLen := GetPropList(typItm.DataType,propList); try for i := 0 to Pred(propCount) do begin p := propList^[i]; - persistType := IsStoredPropClass(objTypeData^.ClassType,p); - if ( persistType in [pstOptional,pstAlways] ) then begin - attProp := clsTyp.IsAttributeProperty(p^.Name); - if attProp then begin - s := Format('%s:%s',[sXSD,sATTRIBUTE]); - propNode := CreateElement(s,cplxNode,AWsdlDocument) - end else begin - s := Format('%s:%s',[sXSD,sELEMENT]); - propNode := CreateElement(s,sqcNode,AWsdlDocument); - end; - propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name)); - propTypItm := GetTypeRegistry().Find(p^.PropType^.Name); - if Assigned(propTypItm) then begin - prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument); - propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); + if ( parentClss = nil ) or ( not IsPublishedProp(parentClss,p^.Name) ) then begin + persistType := IsStoredPropClass(objTypeData^.ClassType,p); + if ( persistType in [pstOptional,pstAlways] ) then begin + attProp := clsTyp.IsAttributeProperty(p^.Name); if attProp then begin - if ( persistType = pstOptional ) then - propNode.SetAttribute(sATTRIBUTE,'optional') - else - propNode.SetAttribute(sATTRIBUTE,'required'); + s := Format('%s:%s',[sXSD,sATTRIBUTE]); + propNode := CreateElement(s,extNode,AWsdlDocument) end else begin - if ( persistType = pstOptional ) then - propNode.SetAttribute(sMIN_OCCURS,'0') - else - propNode.SetAttribute(sMIN_OCCURS,'1'); - propNode.SetAttribute(sMAX_OCCURS,'1'); + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + end; + propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name)); + propTypItm := ATypeRegistry.Find(p^.PropType^.Name); + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); + if attProp then begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sUSE,'optional') + else + propNode.SetAttribute(sUSE,'required'); + end else begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sMIN_OCCURS,'0') + else + propNode.SetAttribute(sMIN_OCCURS,'1'); + propNode.SetAttribute(sMAX_OCCURS,'1'); + end; end; end; end; @@ -704,7 +794,8 @@ end; procedure TEnumTypeHandler.Generate( const APascalTypeName: string; - AWsdlDocument: TXMLDocument + AWsdlDocument: TXMLDocument; + ATypeRegistry : TTypeRegistry ); var typItm : TTypeRegistryItem; @@ -712,7 +803,7 @@ var defTypesNode, defSchemaNode, resNode, restrictNode : TDOMElement; i, c : Integer; begin - typItm := GetTypeRegistry().Find(APascalTypeName); + typItm := ATypeRegistry.Find(APascalTypeName); if Assigned(typItm) and ( typItm.DataType^.Kind = tkEnumeration ) then begin @@ -752,16 +843,22 @@ end; procedure TFakeTypeHandler.Generate( const APascalTypeName: string; - AWsdlDocument: TXMLDocument + AWsdlDocument: TXMLDocument; + ATypeRegistry : TTypeRegistry ); begin end; -procedure RegisterFondamentalTypes(); +function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry; +begin + Result := TWsdlTypeHandlerRegistry.Create(ATypeRegistry) as IWsdlTypeHandlerRegistry; +end; + +procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry); var r : IWsdlTypeHandlerRegistry; begin - r := GetWsdlTypeHandlerRegistry(); + r := ARegistry; r.RegisterDefaultHandler(tkInteger,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); r.RegisterDefaultHandler(tkInt64,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); @@ -782,6 +879,8 @@ begin r.RegisterDefaultHandler(tkClass,TSimpleItemFactory.Create(TBaseComplexRemotable_TypeHandler) as IItemFactory); r.Register('TBaseArrayRemotable',TSimpleItemFactory.Create(TBaseArrayRemotable_TypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkRecord,TSimpleItemFactory.Create(TRecord_TypeHandler) as IItemFactory); { r.Register('Integer',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); r.Register('LongWord',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); @@ -811,7 +910,8 @@ end; procedure TBaseArrayRemotable_TypeHandler.Generate( const APascalTypeName: string; - AWsdlDocument: TXMLDocument + AWsdlDocument: TXMLDocument; + ATypeRegistry : TTypeRegistry ); function GetNameSpaceShortName(const ANameSpace : string):string;//inline; @@ -831,7 +931,7 @@ var arrayTypeData : PTypeData; arrayTypeClass : TBaseArrayRemotableClass; begin - typItm := GetTypeRegistry().Find(APascalTypeName); + typItm := ATypeRegistry.Find(APascalTypeName); if not Assigned(typItm) then Exit; arrayTypeData := GetTypeData(typItm.DataType); @@ -851,10 +951,13 @@ begin s := Format('%s:%s',[sXSD,sSEQUENCE]); sqcNode := CreateElement(s,cplxNode,AWsdlDocument); arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType); - propTypItm := GetTypeRegistry().Find(arrayTypeClass.GetItemTypeInfo()^.Name); + propTypItm := ATypeRegistry.Find(arrayTypeClass.GetItemTypeInfo()^.Name); s := Format('%s:%s',[sXSD,sELEMENT]); propNode := CreateElement(s,sqcNode,AWsdlDocument); - propNode.SetAttribute(sNAME,sITEM); + s := Trim(typItm.GetExternalPropertyName(sARRAY_ITEM)); + if ( s = '' ) then + s := sITEM; + propNode.SetAttribute(sNAME,s); if Assigned(propTypItm) then begin prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace); propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); @@ -864,9 +967,78 @@ begin end; end; +{ TRecord_TypeHandler } + +procedure TRecord_TypeHandler.Generate( + const APascalTypeName : string; + AWsdlDocument : TXMLDocument; + ATypeRegistry : TTypeRegistry +); +var + typItm, propTypItm : TTypeRegistryItem; + s, prop_ns_shortName : string; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; + i : Integer; + p : TRecordFieldInfo; + objTypeData : PRecordTypeData; + persistType : TPropStoreType; +begin + typItm := ATypeRegistry.Find(APascalTypeName); + if Assigned(typItm) and + ( typItm.DataType^.Kind = tkRecord ) + then begin + GetNameSpaceShortName(typItm.NameSpace,AWsdlDocument); + defTypesNode := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + objTypeData := TRecordRttiDataObject(typItm.GetObject(FIELDS_STRING)).GetRecordTypeData(); + persistType := pstOptional; + + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); + cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); + cplxNode.SetAttribute(sNAME, typItm.DeclaredName); + cplxNode.SetAttribute(Format('%s:wst_record',[GetNameSpaceShortName(sWST_BASE_NS,AWsdlDocument,'wst')]),'true'); + + sqcNode := CreateElement(Format('%s:%s',[sXSD,sSEQUENCE]),cplxNode,AWsdlDocument); + if ( objTypeData^.FieldCount > 0 ) then begin + for i := 0 to Pred(objTypeData^.FieldCount) do begin + p := objTypeData^.Fields[i]; + if p.Visible then begin + if p.IsAttribute then begin + s := Format('%s:%s',[sXSD,sATTRIBUTE]); + propNode := CreateElement(s,cplxNode,AWsdlDocument) + end else begin + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + end; + propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p.Name)); + propTypItm := ATypeRegistry.Find(p.TypeInfo^^.Name); + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); + if p.IsAttribute then begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sUSE,'optional') + else + propNode.SetAttribute(sUSE,'required'); + end else begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sMIN_OCCURS,'0') + else + propNode.SetAttribute(sMIN_OCCURS,'1'); + propNode.SetAttribute(sMAX_OCCURS,'1'); + end; + end; + end; + end; + end; + end; +end; + initialization - WsdlTypeHandlerRegistryInst := TWsdlTypeHandlerRegistry.Create() as IWsdlTypeHandlerRegistry; - RegisterFondamentalTypes(); + WsdlTypeHandlerRegistryInst := CreateWsdlTypeHandlerRegistry(GetTypeRegistry()); + RegisterFondamentalTypesHandler(WsdlTypeHandlerRegistryInst); finalization WsdlTypeHandlerRegistryInst := nil; diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr index 24e06ac20..3984e19ab 100644 --- a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr @@ -25,7 +25,8 @@ uses test_rtti_filter in '..\test_rtti_filter.pas', test_wst_cursors in '..\test_wst_cursors.pas', test_registry in '..\test_registry.pas', - test_soap_specific in '..\test_soap_specific.pas'; + test_soap_specific in '..\test_soap_specific.pas', + test_generators_runtime in '..\test_generators_runtime.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr index 41b83d9f5..33dcb7991 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr @@ -12,7 +12,12 @@ uses test_support in '..\test_support.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_generators_runtime in '..\test_generators_runtime.pas', + test_registry in '..\test_registry.pas', + test_soap_specific in '..\test_soap_specific.pas', + test_generators in '..\test_generators.pas', + test_basex_encode in '..\test_basex_encode.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/test_generators_runtime.pas b/wst/trunk/tests/test_suite/test_generators_runtime.pas new file mode 100644 index 000000000..eb692b86b --- /dev/null +++ b/wst/trunk/tests/test_suite/test_generators_runtime.pas @@ -0,0 +1,265 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007, 2008 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_generators_runtime; + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testutils, testregistry, DOM, XmlRead, XmlWrite, wst_fpc_xml, +{$ELSE} + TestFrameWork, xmldom, wst_delphi_xml, +{$ENDIF} + base_service_intf, metadata_wsdl, metadata_repository, wst_types; + +const + sNAMESPACE_SAMPLE = 'urn:sample-namespace'; + +type + + TTestEnum = ( teA, teB, teC ); + + { TClass_A } + + TClass_A = class(TBaseComplexRemotable) + private + FA_StringProp : string; + published + property A_StringProp : string Read FA_StringProp Write FA_StringProp; + end; + + { TClass_AB } + + TClass_AB = class(TClass_A) + private + FAB_IntProp : Integer; + published + property AB_IntProp : Integer read FAB_IntProp write FAB_IntProp; + end; + + { TClass_ABC } + + TClass_ABC = class(TClass_AB) + private + FABC_BoolProp : Boolean; + FABC_EnumAttProp : TTestEnum; + published + property ABC_BoolProp : Boolean read FABC_BoolProp write FABC_BoolProp; + property ABC_EnumAttProp : TTestEnum read FABC_EnumAttProp write FABC_EnumAttProp; + end; + + TArrayOfStringRemotableSample = class(TArrayOfStringRemotable) + end; + + TArrayOfIntRemotableSample = class(TArrayOfInt32SRemotable) + end; + + TTestSmallRecord = record + fieldSmallint : Smallint; + fieldWord : Word; + fieldString : string; + end; + + { TTestWSDLGenerator } + + TTestWSDLGenerator= class(TTestCase) + protected + function CreateRepository() : PServiceRepository; + published + procedure generate_complex_type_derivation(); + procedure generate_enum(); + procedure generate_array(); + procedure generate_record(); + end; + +implementation +uses + TypInfo, record_rtti, test_suite_utils; + +{$IFDEF WST_RECORD_RTTI} +function __TTestSmallRecord_TYPEINFO_FUNC__() : PTypeInfo; +var + p : ^TTestSmallRecord; + r : TTestSmallRecord; +begin + p := @r; + Result := MakeRawTypeInfo( + 'TTestSmallRecord', + SizeOf(TTestSmallRecord), + [ PtrUInt(@(p^.fieldSmallint)) - PtrUInt(p), PtrUInt(@(p^.fieldWord)) - PtrUInt(p), PtrUInt(@(p^.fieldString)) - PtrUInt(p) ], + [ TypeInfo(SmallInt), TypeInfo(Word), TypeInfo(String) ] + ); +end; +{$ENDIF WST_RECORD_RTTI} + +{ TTestWSDLGenerator } + +function TTestWSDLGenerator.CreateRepository() : PServiceRepository; +var + locRes : PServiceRepository; +begin + New(locRes); + locRes^.Name := 'runtime_generator'; + locRes^.NameSpace := sNAMESPACE_SAMPLE; + locRes^.RootAddress := 'http://runtime-generator-sample.com'; + locRes^.Services := nil; + locRes^.ServicesCount := 0; + Result := locRes; +end; + +procedure TTestWSDLGenerator.generate_complex_type_derivation(); +var + locRep : PServiceRepository; + locDoc, locExistDoc : TXMLDocument; + typeReg : TTypeRegistry; + handlerReg : IWsdlTypeHandlerRegistry; +begin + locExistDoc := nil; + typeReg := nil; + locDoc := nil; + locRep := CreateRepository(); + try + typeReg := TTypeRegistry.Create(); + RegisterStdTypes(typeReg); + typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TTestEnum)); + typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TClass_A),'TClass_A'); + typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TClass_AB),'TClass_AB'); + typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TClass_ABC),'Class_ABC'); + handlerReg := CreateWsdlTypeHandlerRegistry(typeReg); + RegisterFondamentalTypesHandler(handlerReg); + locDoc := CreateDoc(); + GenerateWSDL(locRep,locDoc,typeReg,handlerReg); + WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_complex_type_derivation.wsdl')); + ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_complex_type_derivation.wsdl')); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + typeReg.Free(); + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + Dispose(locRep); + end; +end; + +procedure TTestWSDLGenerator.generate_enum(); +var + locRep : PServiceRepository; + locDoc, locExistDoc : TXMLDocument; + typeReg : TTypeRegistry; + handlerReg : IWsdlTypeHandlerRegistry; +begin + locExistDoc := nil; + typeReg := nil; + locDoc := nil; + locRep := CreateRepository(); + try + typeReg := TTypeRegistry.Create(); + RegisterStdTypes(typeReg); + with typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TTestEnum),'TestEnum_Type') do begin + RegisterExternalPropertyName('teA', 'A'); + RegisterExternalPropertyName('teC', 'The C Item'); + end; + handlerReg := CreateWsdlTypeHandlerRegistry(typeReg); + RegisterFondamentalTypesHandler(handlerReg); + locDoc := CreateDoc(); + GenerateWSDL(locRep,locDoc,typeReg,handlerReg); + WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_generate_enum.wsdl')); + ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_generate_enum.wsdl')); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + typeReg.Free(); + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + Dispose(locRep); + end; +end; + +procedure TTestWSDLGenerator.generate_array(); +var + locRep : PServiceRepository; + locDoc, locExistDoc : TXMLDocument; + typeReg : TTypeRegistry; + handlerReg : IWsdlTypeHandlerRegistry; +begin + locExistDoc := nil; + typeReg := nil; + locDoc := nil; + locRep := CreateRepository(); + try + typeReg := TTypeRegistry.Create(); + RegisterStdTypes(typeReg); + typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TArrayOfStringRemotableSample)); + with typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TArrayOfIntRemotableSample)) do begin + RegisterExternalPropertyName(sARRAY_ITEM,'int_value'); + RegisterExternalPropertyName(sARRAY_STYLE,sScoped); + end; + handlerReg := CreateWsdlTypeHandlerRegistry(typeReg); + RegisterFondamentalTypesHandler(handlerReg); + locDoc := CreateDoc(); + GenerateWSDL(locRep,locDoc,typeReg,handlerReg); + WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_generate_array.wsdl')); + ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_generate_array.wsdl')); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + typeReg.Free(); + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + Dispose(locRep); + end; +end; + +procedure TTestWSDLGenerator.generate_record(); +var + locRep : PServiceRepository; + locDoc, locExistDoc : TXMLDocument; + typeReg : TTypeRegistry; + handlerReg : IWsdlTypeHandlerRegistry; +begin + locExistDoc := nil; + typeReg := nil; + locDoc := nil; + locRep := CreateRepository(); + try + typeReg := TTypeRegistry.Create(); + RegisterStdTypes(typeReg); + with typeReg.Register(sNAMESPACE_SAMPLE,TypeInfo(TTestSmallRecord)) do begin + RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString'); + end; +{$IFNDEF WST_RECORD_RTTI} + typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); +{$ENDIF WST_RECORD_RTTI} +{$IFDEF WST_RECORD_RTTI} + typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); +{$ENDIF WST_RECORD_RTTI} + (typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetObject(FIELDS_STRING) as TRecordRttiDataObject).GetField('fieldWord')^.IsAttribute := True; + handlerReg := CreateWsdlTypeHandlerRegistry(typeReg); + RegisterFondamentalTypesHandler(handlerReg); + locDoc := CreateDoc(); + GenerateWSDL(locRep,locDoc,typeReg,handlerReg); + WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_generate_record.wsdl')); + ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_generate_record.wsdl')); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + typeReg.Free(); + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + Dispose(locRep); + end; +end; + +initialization + TClass_ABC.RegisterAttributeProperty('ABC_EnumAttProp'); + + RegisterTest('Runtime Generators',TTestWSDLGenerator.Suite); + +end. diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 15cf56c8b..9acce164e 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -45,6 +45,7 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;virtual;abstract; @@ -67,6 +68,7 @@ type procedure ComplexType_ArraySequence(); procedure ComplexType_ArraySequence_Embedded(); + procedure ComplexType_Array_soaparray(); procedure ComplexType_CollectionSequence(); procedure pascal_class_default_parent(); @@ -95,6 +97,7 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; @@ -124,12 +127,16 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override; published procedure no_binding_style(); + procedure signature_last(); + procedure signature_result(); + procedure signature_return(); end; implementation @@ -156,6 +163,7 @@ const x_complexType_array_sequence = 'complex_array_sequence'; x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded'; x_complexType_array_sequence_collection = 'complex_array_sequence_collection'; + x_complexType_array_soaparray = 'complex_array_soaparray'; x_complexType_class = 'complex_class'; x_complexType_class_default = 'complex_class_default'; @@ -271,7 +279,6 @@ var elt : TPasElement; enumType : TPasEnumType; enumVal : TPasEnumValue; - aliasType : TPasAliasType; i : Integer; begin tr := LoadSimpleType_Enum_Embedded_Schema(); @@ -308,7 +315,6 @@ var ls : TList; elt : TPasElement; aliasType : TPasAliasType; - i : Integer; begin tr := LoadSimpleType_AliasToNativeType_Schema(); @@ -476,7 +482,6 @@ var procedure CheckEmbeddedClassType(); var - mdl : TPasModule; e : TPasElement; k : Integer; prpLst : TList; @@ -537,7 +542,6 @@ var clsType : TPasClassType; ls : TList; elt : TPasElement; - aliasType : TPasAliasType; i : Integer; prpLs : TList; begin @@ -605,7 +609,6 @@ var mdl : TPasModule; ls : TList; elt : TPasElement; - aliasType : TPasAliasType; i : Integer; prpLs : TList; begin @@ -775,7 +778,6 @@ var mdl : TPasModule; ls : TList; elt : TPasElement; - aliasType : TPasAliasType; i : Integer; prpLs : TList; begin @@ -860,7 +862,6 @@ var ls : TList; elt : TPasElement; arrayType : TPasArrayType; - aliasType : TPasAliasType; i : Integer; prpLs : TList; nestedClassName : string; @@ -948,7 +949,6 @@ var ls : TList; elt : TPasElement; arrayType : TPasArrayType; - aliasType : TPasAliasType; i : Integer; prpLs : TList; nestedClassName : string; @@ -1013,6 +1013,39 @@ begin end; end; +procedure TTest_CustomXsdParser.ComplexType_Array_soaparray(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt : TPasElement; + arrayType : TPasArrayType; +begin + tr := LoadComplexType_Array_soaparray(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_array_soaparray,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement(x_complexType_SampleArrayIntFieldType); + CheckNotNull(elt,x_complexType_SampleArrayIntFieldType); + CheckEquals(x_complexType_SampleArrayIntFieldType,elt.Name); + CheckEquals(x_complexType_SampleArrayIntFieldType,tr.GetExternalName(elt)); + CheckIs(elt,TPasArrayType); + arrayType := elt as TPasArrayType; + CheckNotNull(arrayType.ElType); + CheckEquals('int',tr.GetExternalName(arrayType.ElType)); + CheckEquals('item',tr.GetArrayItemName(arrayType)); + CheckEquals('item',tr.GetArrayItemExternalName(arrayType)); + + CheckNull(tr.FindElementNS('Array','http://schemas.xmlsoap.org/wsdl/')); + finally + tr.Free(); + end; +end; + procedure TTest_CustomXsdParser.ComplexType_CollectionSequence(); var tr : TwstPasTreeContainer; @@ -1036,7 +1069,6 @@ var ls : TList; elt : TPasElement; arrayType : TPasArrayType; - aliasType : TPasAliasType; i : Integer; prpLs : TList; nestedClassName : string; @@ -1155,7 +1187,6 @@ var mdl : TPasModule; ls : TList; elt : TPasElement; - aliasType : TPasAliasType; i : Integer; prpLs : TList; begin @@ -1229,7 +1260,6 @@ var mdl : TPasModule; ls : TList; elt : TPasElement; - aliasType : TPasAliasType; i : Integer; prpLs : TList; begin @@ -1343,6 +1373,11 @@ begin Result := ParseDoc(x_complexType_array_sequence_embedded); end; +function TTest_XsdParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_array_soaparray); +end; + function TTest_XsdParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_array_sequence_collection); @@ -1441,6 +1476,11 @@ begin Result := ParseDoc(x_complexType_array_sequence_embedded); end; +function TTest_WsdlParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_array_soaparray); +end; + function TTest_WsdlParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_array_sequence_collection); @@ -1470,6 +1510,230 @@ begin end; end; +procedure TTest_WsdlParser.signature_last(); +var + tr : TwstPasTreeContainer; + elt : TPasElement; + intf : TPasClassType; + i : Integer; + mth : TPasProcedure; + mthType : TPasProcedureType; + res : TPasResultElement; + arg : TPasArgument; +begin + tr := ParseDoc('signature_last'); + try + elt := tr.FindElement('TestService'); + CheckNotNull(elt,'TestService'); + CheckIs(elt,TPasClassType); + intf := elt as TPasClassType; + CheckEquals(Ord(okInterface),Ord(intf.ObjKind)); + mth := nil; + for i := 0 to (intf.Members.Count - 1) do begin + if TObject(intf.Members[i]).InheritsFrom(TPasProcedure) then begin + mth := TPasProcedure(intf.Members[i]); + Break; + end; + end; + CheckNotNull(mth,'test_proc not found'); + CheckEquals('test_proc',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals('integer', LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name)); + finally + tr.Free(); + end; +end; + +procedure TTest_WsdlParser.signature_result(); + + function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure; + var + k : Integer; + begin + Result := nil; + for k := 0 to (AIntf.Members.Count - 1) do begin + if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin + Result := TPasProcedure(AIntf.Members[k]); + Break; + end; + end; + end; + +var + tr : TwstPasTreeContainer; + elt : TPasElement; + intf : TPasClassType; + mth : TPasProcedure; + mthType : TPasProcedureType; + res : TPasResultElement; + arg : TPasArgument; +begin + tr := ParseDoc('signature_result'); + try + elt := tr.FindElement('TestService'); + CheckNotNull(elt,'TestService'); + CheckIs(elt,TPasClassType); + intf := elt as TPasClassType; + CheckEquals(Ord(okInterface),Ord(intf.ObjKind)); + mth := FindProc('test_proc',intf); + CheckNotNull(mth,'test_proc not found'); + CheckEquals('test_proc',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + + mth := FindProc('test_proc2',intf); + CheckNotNull(mth,'test_proc2 not found'); + CheckEquals('test_proc2',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('string'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + + mth := FindProc('test_proc3',intf); + CheckNotNull(mth,'test_proc3 not found'); + CheckEquals('test_proc3',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + finally + tr.Free(); + end; +end; + +procedure TTest_WsdlParser.signature_return(); + + function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure; + var + k : Integer; + begin + Result := nil; + for k := 0 to (AIntf.Members.Count - 1) do begin + if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin + Result := TPasProcedure(AIntf.Members[k]); + Break; + end; + end; + end; + +var + tr : TwstPasTreeContainer; + elt : TPasElement; + intf : TPasClassType; + mth : TPasProcedure; + mthType : TPasProcedureType; + res : TPasResultElement; + arg : TPasArgument; +begin + tr := ParseDoc('signature_return'); + try + elt := tr.FindElement('TestService'); + CheckNotNull(elt,'TestService'); + CheckIs(elt,TPasClassType); + intf := elt as TPasClassType; + CheckEquals(Ord(okInterface),Ord(intf.ObjKind)); + mth := FindProc('test_proc',intf); + CheckNotNull(mth,'test_proc not found'); + CheckEquals('test_proc',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + + mth := FindProc('test_proc2',intf); + CheckNotNull(mth,'test_proc2 not found'); + CheckEquals('test_proc2',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('string'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('boolean'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + + mth := FindProc('test_proc3',intf); + CheckNotNull(mth,'test_proc3 not found'); + CheckEquals('test_proc3',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasFunctionType); + res := TPasFunctionType(mthType).ResultEl; + CheckNotNull(res, 'Result'); + CheckEquals(LowerCase('Boolean'), LowerCase(res.ResultType.Name)); + CheckEquals(2, mthType.Args.Count, 'Parameter count'); + arg := TPasArgument(mthType.Args[0]); + CheckNotNull(arg); + CheckEquals(LowerCase('AConstParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name)); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('AOutParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + finally + tr.Free(); + end; +end; + function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_class_default);