From f0a291994a4b6f54ed1bf97bed50ce6a2ebfda1c Mon Sep 17 00:00:00 2001 From: inoussa Date: Tue, 30 Jun 2009 16:40:19 +0000 Subject: [PATCH] parameter access qualifiers in WSDL parsing and generation tests. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@885 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tests/test_suite/files/echo_service.wsdl | 4 +- wst/trunk/tests/test_suite/test_parsers.pas | 62 ++++++++++++++++++- wst/trunk/tests/test_suite/test_utilities.pas | 53 +++++++++++++++- 3 files changed, 113 insertions(+), 6 deletions(-) diff --git a/wst/trunk/tests/test_suite/files/echo_service.wsdl b/wst/trunk/tests/test_suite/files/echo_service.wsdl index d479a8372..aae362aac 100644 --- a/wst/trunk/tests/test_suite/files/echo_service.wsdl +++ b/wst/trunk/tests/test_suite/files/echo_service.wsdl @@ -18,9 +18,9 @@ - + - + diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index cdb8f0193..62045c3c1 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -184,7 +184,8 @@ type procedure xsd_not_declared_at_top_node(); procedure xsd_not_declared_at_top_node_2(); procedure message_parts_type_hint(); - procedure var_parameter(); + procedure parameter_var(); + procedure parameter_const_default(); end; implementation @@ -2390,7 +2391,7 @@ begin end; end; -procedure TTest_WsdlParser.var_parameter(); +procedure TTest_WsdlParser.parameter_var(); function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure; var @@ -2460,6 +2461,63 @@ begin end; end; +procedure TTest_WsdlParser.parameter_const_default(); + + 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('parameter_const_default'); + try + elt := tr.FindElement('TestService'); + CheckNotNull(elt,'TestService'); + CheckIs(elt,TPasClassType); + intf := elt as TPasClassType; + CheckEquals(Ord(okInterface),Ord(intf.ObjKind)); + mth := FindProc('sampleProc',intf); + CheckNotNull(mth,'sampleProc not found'); + CheckEquals('sampleProc',mth.Name); + mthType := mth.ProcType; + CheckIs(mthType,TPasProcedureType); + CheckEquals(3, 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)); + CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'AConstParam'); + arg := TPasArgument(mthType.Args[1]); + CheckNotNull(arg); + CheckEquals(LowerCase('ADefaultParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + CheckEquals('argDefault',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'ADefaultParam'); + arg := TPasArgument(mthType.Args[2]); + CheckNotNull(arg); + CheckEquals(LowerCase('ANonSpecifiedParam'), LowerCase(arg.Name)); + CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name)); + CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'ANonSpecifiedParam'); + finally + tr.Free(); + end; +end; + function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_class_default); diff --git a/wst/trunk/tests/test_suite/test_utilities.pas b/wst/trunk/tests/test_suite/test_utilities.pas index f53301d25..1a906deaf 100644 --- a/wst/trunk/tests/test_suite/test_utilities.pas +++ b/wst/trunk/tests/test_suite/test_utilities.pas @@ -23,7 +23,7 @@ uses {$ENDIF} TypInfo, base_service_intf, server_service_intf, - library_imp_utils; + library_imp_utils, parserutils; type @@ -124,7 +124,14 @@ type procedure GetCount(); procedure GetItem(const AIndex : PtrInt); end; - + + { TTest_Procs } + + TTest_Procs = class(TTestCase) + published + procedure test_GetToken(); + end; + implementation { TTestClass } @@ -737,6 +744,47 @@ begin Check(ok); end; +{ TTest_Procs } + +procedure TTest_Procs.test_GetToken(); + + procedure do_tests(const ADelimiter : string); + var + strBuffer : string; + begin + strBuffer := ''; + CheckEquals('', GetToken(strBuffer,ADelimiter)); + CheckEquals('',strBuffer); + strBuffer := ADelimiter; + CheckEquals('', GetToken(strBuffer,ADelimiter)); + CheckEquals('',strBuffer); + strBuffer := Format('%s123',[ADelimiter]); + CheckEquals('', GetToken(strBuffer,ADelimiter)); + CheckEquals('123',strBuffer); + strBuffer := Format('%s123%s45',[ADelimiter,ADelimiter]); + CheckEquals('', GetToken(strBuffer,ADelimiter)); + CheckEquals(Format('123%s45',[ADelimiter]),strBuffer); + CheckEquals('123', GetToken(strBuffer,ADelimiter)); + CheckEquals('45',strBuffer); + CheckEquals('45', GetToken(strBuffer,ADelimiter)); + CheckEquals('',strBuffer); + + strBuffer := Format('123',[ADelimiter,ADelimiter]); + CheckEquals('123', GetToken(strBuffer,ADelimiter)); + CheckEquals('',strBuffer); + strBuffer := Format('123%s45',[ADelimiter,ADelimiter]); + CheckEquals('123', GetToken(strBuffer,ADelimiter)); + CheckEquals(Format('45',[ADelimiter]),strBuffer); + CheckEquals('45', GetToken(strBuffer,ADelimiter)); + CheckEquals('',strBuffer); + end; + +begin + do_tests(';'); + do_tests('##'); + do_tests('#<#'); +end; + initialization RegisterTest('Utilities',TTest_TIntfPool.Suite); RegisterTest('Utilities',TTest_TSimpleItemFactoryEx.Suite); @@ -744,5 +792,6 @@ initialization RegisterTest('Utilities',TTest_TIntfPoolItem.Suite); RegisterTest('Utilities',TTest_TImplementationFactory.Suite); RegisterTest('Utilities',TTest_TwstModuleManager.Suite); + RegisterTest('Utilities',TTest_Procs.Suite); end.