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
This commit is contained in:
parent
c899af0c2d
commit
c8c6f3c942
@ -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;
|
||||
|
@ -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}
|
||||
|
||||
|
@ -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}
|
||||
|
||||
|
265
wst/trunk/tests/test_suite/test_generators_runtime.pas
Normal file
265
wst/trunk/tests/test_suite/test_generators_runtime.pas
Normal 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.
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user