pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases 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
Download Patch File Download Diff File Expand all files Collapse all files

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_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}

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_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
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_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);