paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Part 2

Browse Source 
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
This commit is contained in:
inoussa 2008-09-10 01:19:04 +00:00
parent c899af0c2d
commit c8c6f3c942
5 changed files with 779 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

290
wst/trunk/metadata_wsdl.pas
View File

@ -13,6 +13,8 @@
{$INCLUDE wst_global.inc} {$INCLUDE wst_global.inc}
unit metadata_wsdl; unit metadata_wsdl;
{$RANGECHECKS OFF}
interface interface
uses uses
@ -26,7 +28,8 @@ type
['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}'] ['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}']
procedure Generate( procedure Generate(
const APascalTypeName : string; const APascalTypeName : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
end; end;
@ -49,7 +52,8 @@ type
protected protected
procedure Generate( procedure Generate(
const APascalTypeName : string; const APascalTypeName : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
end; end;
@ -59,7 +63,8 @@ type
protected protected
procedure Generate( procedure Generate(
const APascalTypeName : string; const APascalTypeName : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
end; end;
@ -69,23 +74,46 @@ type
protected protected
procedure Generate( procedure Generate(
const APascalTypeName : string; const APascalTypeName : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
end; 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; procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);overload;
function GenerateWSDL(const ARepName, ARootAddress : string):string;overload; function GenerateWSDL(const ARepName, ARootAddress : string):string;overload;
function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry;
function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry;
procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry);
implementation implementation
uses uses
wst_types wst_types
{$IFNDEF FPC} {$IFDEF WST_DELPHI}
, wst_delphi_rtti_utils , wst_delphi_rtti_utils
{$ELSE} {$ENDIF}
{$IFDEF FPC}
, wst_fpc_xml, XmlWrite , wst_fpc_xml, XmlWrite
{$ENDIF}; {$ENDIF}
, record_rtti;
const const
sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/'; sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/';
@ -107,9 +135,11 @@ const
sBASE = 'base'; sBASE = 'base';
sBINDING = 'binding'; sBINDING = 'binding';
sBODY = 'body'; sBODY = 'body';
sCOMPLEX_CONTENT = 'complexContent';
sCOMPLEX_TYPE = 'complexType'; sCOMPLEX_TYPE = 'complexType';
sELEMENT = 'element'; sELEMENT = 'element';
sENUMERATION = 'enumeration'; sENUMERATION = 'enumeration';
sEXTENSION = 'extension';
sITEM = 'item'; sITEM = 'item';
sLOCATION = 'location'; sLOCATION = 'location';
sMIN_OCCURS = 'minOccurs'; sMIN_OCCURS = 'minOccurs';
@ -125,6 +155,7 @@ const
sTRANSPORT = 'transport'; sTRANSPORT = 'transport';
sTYPE = 'type'; sTYPE = 'type';
sUNBOUNDED = 'unbounded'; sUNBOUNDED = 'unbounded';
sUSE = 'use';
sVALUE = 'value'; sVALUE = 'value';
sWSDL_DEFINITIONS = 'definitions'; sWSDL_DEFINITIONS = 'definitions';
@ -153,6 +184,7 @@ type
TWsdlTypeHandlerRegistry = class(TBaseFactoryRegistry,IInterface,IWsdlTypeHandlerRegistry) TWsdlTypeHandlerRegistry = class(TBaseFactoryRegistry,IInterface,IWsdlTypeHandlerRegistry)
private private
FTypeRegistry : TTypeRegistry;
FDefaultHandlerTable : Array[TTypeKind] of IItemFactory; FDefaultHandlerTable : Array[TTypeKind] of IItemFactory;
private private
function FindNearestClass(const AClassType : TClass):IItemFactory; function FindNearestClass(const AClassType : TClass):IItemFactory;
@ -163,6 +195,7 @@ type
AFactory : IItemFactory AFactory : IItemFactory
); );
public public
constructor Create(ATypeRegistry : TTypeRegistry);
destructor Destroy();override; destructor Destroy();override;
End; End;
@ -196,7 +229,7 @@ begin
Result := nil; Result := nil;
foundIndex := -1; foundIndex := -1;
score := MaxInt; score := MaxInt;
r := GetTypeRegistry(); r := FTypeRegistry;
c := Count; c := Count;
for i := 0 to Pred(c) do begin for i := 0 to Pred(c) do begin
itm := Item[i]; itm := Item[i];
@ -223,7 +256,7 @@ begin
Result := nil; Result := nil;
fct := FindFactory(APascalTypeName); fct := FindFactory(APascalTypeName);
if not Assigned(fct) then begin if not Assigned(fct) then begin
ri := GetTypeRegistry().Find(APascalTypeName); ri := FTypeRegistry.Find(APascalTypeName);
if Assigned(ri) then begin if Assigned(ri) then begin
if ( ri.DataType^.Kind = tkClass ) then if ( ri.DataType^.Kind = tkClass ) then
fct := FindNearestClass(GetTypeData(ri.DataType)^.ClassType); fct := FindNearestClass(GetTypeData(ri.DataType)^.ClassType);
@ -243,6 +276,13 @@ begin
FDefaultHandlerTable[ATypeKind] := AFactory; FDefaultHandlerTable[ATypeKind] := AFactory;
end; end;
constructor TWsdlTypeHandlerRegistry.Create(ATypeRegistry : TTypeRegistry);
begin
Assert(ATypeRegistry <> nil);
inherited Create();
FTypeRegistry := ATypeRegistry;
end;
destructor TWsdlTypeHandlerRegistry.Destroy(); destructor TWsdlTypeHandlerRegistry.Destroy();
var var
i : TTypeKind; i : TTypeKind;
@ -292,13 +332,16 @@ end;
function GetNameSpaceShortName( function GetNameSpaceShortName(
const ANameSpace : string; const ANameSpace : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
const APreferedShortName : string = ''
):string;//inline; ):string;//inline;
begin begin
if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin
Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt);
end else begin 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); AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace);
end; end;
end; end;
@ -311,7 +354,16 @@ begin
end; end;
procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument); 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( procedure GenerateServiceMessages(
AService : PService; AService : PService;
ARootNode : TDOMElement ARootNode : TDOMElement
@ -327,7 +379,7 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);
begin begin
tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc); tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc);
tmpNode.SetAttribute(sWSDL_NAME,APrm^.Name); tmpNode.SetAttribute(sWSDL_NAME,APrm^.Name);
typItm := GetTypeRegistry().Find(APrm^.TypeName); typItm := ATypeRegistry.Find(APrm^.TypeName);
if not Assigned(typItm) then if not Assigned(typItm) then
raise EMetadataException.CreateFmt('Type not registered : "%s".',[APrm^.TypeName]); raise EMetadataException.CreateFmt('Type not registered : "%s".',[APrm^.TypeName]);
//Assert(Assigned(typItm),APrm^.TypeName); //Assert(Assigned(typItm),APrm^.TypeName);
@ -495,8 +547,8 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);
g : IWsdlTypeHandler; g : IWsdlTypeHandler;
gr : IWsdlTypeHandlerRegistry; gr : IWsdlTypeHandlerRegistry;
begin begin
tr := GetTypeRegistry(); tr := ATypeRegistry;
gr := GetWsdlTypeHandlerRegistry(); gr := AHandlerRegistry;
k := tr.Count; k := tr.Count;
for j := 0 to Pred(k) do begin for j := 0 to Pred(k) do begin
tri := tr[j]; tri := tr[j];
@ -505,7 +557,7 @@ procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);
then begin then begin
g := gr.Find(tri.DataType^.Name); g := gr.Find(tri.DataType^.Name);
if assigned(g) then if assigned(g) then
g.Generate(tri.DataType^.Name,ADoc); g.Generate(tri.DataType^.Name,ADoc,tr);
end; end;
end; end;
end; end;
@ -617,7 +669,8 @@ type
protected protected
procedure Generate( procedure Generate(
const APascalTypeName : string; const APascalTypeName : string;
AWsdlDocument : TXMLDocument AWsdlDocument : TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
end; end;
@ -625,12 +678,29 @@ type
procedure TBaseComplexRemotable_TypeHandler.Generate( procedure TBaseComplexRemotable_TypeHandler.Generate(
const APascalTypeName : string; 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 var
typItm, propTypItm : TTypeRegistryItem; typItm, propTypItm : TTypeRegistryItem;
s, prop_ns_shortName : string; s, prop_ns_shortName : string;
defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, cplxContentNode, extNode : TDOMElement;
i : Integer; i : Integer;
propList : PPropList; propList : PPropList;
propCount, propListLen : Integer; propCount, propListLen : Integer;
@ -639,8 +709,10 @@ var
objTypeData : PTypeData; objTypeData : PTypeData;
clsTyp : TBaseComplexRemotableClass; clsTyp : TBaseComplexRemotableClass;
attProp : Boolean; attProp : Boolean;
parentRegItem : TTypeRegistryItem;
parentClss : TClass;
begin begin
typItm := GetTypeRegistry().Find(APascalTypeName); typItm := ATypeRegistry.Find(APascalTypeName);
if Assigned(typItm) and if Assigned(typItm) and
( typItm.DataType^.Kind = tkClass ) ( typItm.DataType^.Kind = tkClass )
then begin then begin
@ -649,46 +721,64 @@ begin
Assert(Assigned(defTypesNode)); Assert(Assigned(defTypesNode));
defSchemaNode := defTypesNode.FirstChild as TDOMElement; 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]); s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); 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(Format('%s:%s',[sXSD,sSEQUENCE]),extNode,AWsdlDocument);
sqcNode := CreateElement(s,cplxNode,AWsdlDocument);
objTypeData := GetTypeData(typItm.DataType);
clsTyp := TBaseComplexRemotableClass(objTypeData^.ClassType);
propCount := objTypeData^.PropCount; propCount := objTypeData^.PropCount;
if ( propCount > 0 ) then begin if ( propCount > 0 ) then begin
propListLen := GetPropList(typItm.DataType,propList); propListLen := GetPropList(typItm.DataType,propList);
try try
for i := 0 to Pred(propCount) do begin for i := 0 to Pred(propCount) do begin
p := propList^[i]; p := propList^[i];
persistType := IsStoredPropClass(objTypeData^.ClassType,p); if ( parentClss = nil ) or ( not IsPublishedProp(parentClss,p^.Name) ) then begin
if ( persistType in [pstOptional,pstAlways] ) then begin persistType := IsStoredPropClass(objTypeData^.ClassType,p);
attProp := clsTyp.IsAttributeProperty(p^.Name); if ( persistType in [pstOptional,pstAlways] ) then begin
if attProp then begin attProp := clsTyp.IsAttributeProperty(p^.Name);
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 attProp then begin if attProp then begin
if ( persistType = pstOptional ) then s := Format('%s:%s',[sXSD,sATTRIBUTE]);
propNode.SetAttribute(sATTRIBUTE,'optional') propNode := CreateElement(s,extNode,AWsdlDocument)
else
propNode.SetAttribute(sATTRIBUTE,'required');
end else begin end else begin
if ( persistType = pstOptional ) then s := Format('%s:%s',[sXSD,sELEMENT]);
propNode.SetAttribute(sMIN_OCCURS,'0') propNode := CreateElement(s,sqcNode,AWsdlDocument);
else end;
propNode.SetAttribute(sMIN_OCCURS,'1'); propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name));
propNode.SetAttribute(sMAX_OCCURS,'1'); 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; end;
end; end;
@ -704,7 +794,8 @@ end;
procedure TEnumTypeHandler.Generate( procedure TEnumTypeHandler.Generate(
const APascalTypeName: string; const APascalTypeName: string;
AWsdlDocument: TXMLDocument AWsdlDocument: TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
var var
typItm : TTypeRegistryItem; typItm : TTypeRegistryItem;
@ -712,7 +803,7 @@ var
defTypesNode, defSchemaNode, resNode, restrictNode : TDOMElement; defTypesNode, defSchemaNode, resNode, restrictNode : TDOMElement;
i, c : Integer; i, c : Integer;
begin begin
typItm := GetTypeRegistry().Find(APascalTypeName); typItm := ATypeRegistry.Find(APascalTypeName);
if Assigned(typItm) and if Assigned(typItm) and
( typItm.DataType^.Kind = tkEnumeration ) ( typItm.DataType^.Kind = tkEnumeration )
then begin then begin
@ -752,16 +843,22 @@ end;
procedure TFakeTypeHandler.Generate( procedure TFakeTypeHandler.Generate(
const APascalTypeName: string; const APascalTypeName: string;
AWsdlDocument: TXMLDocument AWsdlDocument: TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
begin begin
end; end;
procedure RegisterFondamentalTypes(); function CreateWsdlTypeHandlerRegistry(ATypeRegistry : TTypeRegistry):IWsdlTypeHandlerRegistry;
begin
Result := TWsdlTypeHandlerRegistry.Create(ATypeRegistry) as IWsdlTypeHandlerRegistry;
end;
procedure RegisterFondamentalTypesHandler(ARegistry : IWsdlTypeHandlerRegistry);
var var
r : IWsdlTypeHandlerRegistry; r : IWsdlTypeHandlerRegistry;
begin begin
r := GetWsdlTypeHandlerRegistry(); r := ARegistry;
r.RegisterDefaultHandler(tkInteger,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); r.RegisterDefaultHandler(tkInteger,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkInt64,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.RegisterDefaultHandler(tkClass,TSimpleItemFactory.Create(TBaseComplexRemotable_TypeHandler) as IItemFactory);
r.Register('TBaseArrayRemotable',TSimpleItemFactory.Create(TBaseArrayRemotable_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('Integer',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.Register('LongWord',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); r.Register('LongWord',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
@ -811,7 +910,8 @@ end;
procedure TBaseArrayRemotable_TypeHandler.Generate( procedure TBaseArrayRemotable_TypeHandler.Generate(
const APascalTypeName: string; const APascalTypeName: string;
AWsdlDocument: TXMLDocument AWsdlDocument: TXMLDocument;
ATypeRegistry : TTypeRegistry
); );
function GetNameSpaceShortName(const ANameSpace : string):string;//inline; function GetNameSpaceShortName(const ANameSpace : string):string;//inline;
@ -831,7 +931,7 @@ var
arrayTypeData : PTypeData; arrayTypeData : PTypeData;
arrayTypeClass : TBaseArrayRemotableClass; arrayTypeClass : TBaseArrayRemotableClass;
begin begin
typItm := GetTypeRegistry().Find(APascalTypeName); typItm := ATypeRegistry.Find(APascalTypeName);
if not Assigned(typItm) then if not Assigned(typItm) then
Exit; Exit;
arrayTypeData := GetTypeData(typItm.DataType); arrayTypeData := GetTypeData(typItm.DataType);
@ -851,10 +951,13 @@ begin
s := Format('%s:%s',[sXSD,sSEQUENCE]); s := Format('%s:%s',[sXSD,sSEQUENCE]);
sqcNode := CreateElement(s,cplxNode,AWsdlDocument); sqcNode := CreateElement(s,cplxNode,AWsdlDocument);
arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType); arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType);
propTypItm := GetTypeRegistry().Find(arrayTypeClass.GetItemTypeInfo()^.Name); propTypItm := ATypeRegistry.Find(arrayTypeClass.GetItemTypeInfo()^.Name);
s := Format('%s:%s',[sXSD,sELEMENT]); s := Format('%s:%s',[sXSD,sELEMENT]);
propNode := CreateElement(s,sqcNode,AWsdlDocument); 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 if Assigned(propTypItm) then begin
prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace); prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace);
propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName]));
@ -864,9 +967,78 @@ begin
end; end;
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 initialization
WsdlTypeHandlerRegistryInst := TWsdlTypeHandlerRegistry.Create() as IWsdlTypeHandlerRegistry; WsdlTypeHandlerRegistryInst := CreateWsdlTypeHandlerRegistry(GetTypeRegistry());
RegisterFondamentalTypes(); RegisterFondamentalTypesHandler(WsdlTypeHandlerRegistryInst);
finalization finalization
WsdlTypeHandlerRegistryInst := nil; WsdlTypeHandlerRegistryInst := nil;

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

@ -25,7 +25,8 @@ uses
test_rtti_filter in '..\test_rtti_filter.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_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} {$R *.res}

7
wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr
View File

@ -12,7 +12,12 @@ uses
test_support in '..\test_support.pas', test_support in '..\test_support.pas',
test_std_cursors in '..\test_std_cursors.pas', test_std_cursors in '..\test_std_cursors.pas',
test_rtti_filter in '..\test_rtti_filter.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} {$R *.res}

265
wst/trunk/tests/test_suite/test_generators_runtime.pas Normal file
View File

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

286
wst/trunk/tests/test_suite/test_parsers.pas
View File

@ -45,6 +45,7 @@ type
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_ArraySequence_Embedded_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; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;virtual;abstract;
@ -67,6 +68,7 @@ type
procedure ComplexType_ArraySequence(); procedure ComplexType_ArraySequence();
procedure ComplexType_ArraySequence_Embedded(); procedure ComplexType_ArraySequence_Embedded();
procedure ComplexType_Array_soaparray();
procedure ComplexType_CollectionSequence(); procedure ComplexType_CollectionSequence();
procedure pascal_class_default_parent(); procedure pascal_class_default_parent();
@ -95,6 +97,7 @@ type
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override;
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
@ -124,12 +127,16 @@ type
function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Array_soaparray() : TwstPasTreeContainer;override;
function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override; function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override;
published published
procedure no_binding_style(); procedure no_binding_style();
procedure signature_last();
procedure signature_result();
procedure signature_return();
end; end;
implementation implementation
@ -156,6 +163,7 @@ const
x_complexType_array_sequence = 'complex_array_sequence'; x_complexType_array_sequence = 'complex_array_sequence';
x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded'; x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded';
x_complexType_array_sequence_collection = 'complex_array_sequence_collection'; x_complexType_array_sequence_collection = 'complex_array_sequence_collection';
x_complexType_array_soaparray = 'complex_array_soaparray';
x_complexType_class = 'complex_class'; x_complexType_class = 'complex_class';
x_complexType_class_default = 'complex_class_default'; x_complexType_class_default = 'complex_class_default';
@ -271,7 +279,6 @@ var
elt : TPasElement; elt : TPasElement;
enumType : TPasEnumType; enumType : TPasEnumType;
enumVal : TPasEnumValue; enumVal : TPasEnumValue;
aliasType : TPasAliasType;
i : Integer; i : Integer;
begin begin
tr := LoadSimpleType_Enum_Embedded_Schema(); tr := LoadSimpleType_Enum_Embedded_Schema();
@ -308,7 +315,6 @@ var
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType; aliasType : TPasAliasType;
i : Integer;
begin begin
tr := LoadSimpleType_AliasToNativeType_Schema(); tr := LoadSimpleType_AliasToNativeType_Schema();
@ -476,7 +482,6 @@ var
procedure CheckEmbeddedClassType(); procedure CheckEmbeddedClassType();
var var
mdl : TPasModule;
e : TPasElement; e : TPasElement;
k : Integer; k : Integer;
prpLst : TList; prpLst : TList;
@ -537,7 +542,6 @@ var
clsType : TPasClassType; clsType : TPasClassType;
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
begin begin
@ -605,7 +609,6 @@ var
mdl : TPasModule; mdl : TPasModule;
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
begin begin
@ -775,7 +778,6 @@ var
mdl : TPasModule; mdl : TPasModule;
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
begin begin
@ -860,7 +862,6 @@ var
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
arrayType : TPasArrayType; arrayType : TPasArrayType;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
nestedClassName : string; nestedClassName : string;
@ -948,7 +949,6 @@ var
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
arrayType : TPasArrayType; arrayType : TPasArrayType;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
nestedClassName : string; nestedClassName : string;
@ -1013,6 +1013,39 @@ begin
end; end;
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(); procedure TTest_CustomXsdParser.ComplexType_CollectionSequence();
var var
tr : TwstPasTreeContainer; tr : TwstPasTreeContainer;
@ -1036,7 +1069,6 @@ var
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
arrayType : TPasArrayType; arrayType : TPasArrayType;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
nestedClassName : string; nestedClassName : string;
@ -1155,7 +1187,6 @@ var
mdl : TPasModule; mdl : TPasModule;
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
begin begin
@ -1229,7 +1260,6 @@ var
mdl : TPasModule; mdl : TPasModule;
ls : TList; ls : TList;
elt : TPasElement; elt : TPasElement;
aliasType : TPasAliasType;
i : Integer; i : Integer;
prpLs : TList; prpLs : TList;
begin begin
@ -1343,6 +1373,11 @@ begin
Result := ParseDoc(x_complexType_array_sequence_embedded); Result := ParseDoc(x_complexType_array_sequence_embedded);
end; end;
function TTest_XsdParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_array_soaparray);
end;
function TTest_XsdParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; function TTest_XsdParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;
begin begin
Result := ParseDoc(x_complexType_array_sequence_collection); Result := ParseDoc(x_complexType_array_sequence_collection);
@ -1441,6 +1476,11 @@ begin
Result := ParseDoc(x_complexType_array_sequence_embedded); Result := ParseDoc(x_complexType_array_sequence_embedded);
end; end;
function TTest_WsdlParser.LoadComplexType_Array_soaparray() : TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_array_soaparray);
end;
function TTest_WsdlParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; function TTest_WsdlParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;
begin begin
Result := ParseDoc(x_complexType_array_sequence_collection); Result := ParseDoc(x_complexType_array_sequence_collection);
@ -1470,6 +1510,230 @@ begin
end; end;
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; function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
begin begin
Result := ParseDoc(x_complexType_class_default); Result := ParseDoc(x_complexType_class_default);