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

wst/trunk/tests/test_suite/files/echo_service.wsdl

@@ -18,9 +18,9 @@
     <part name="result" type="xsd:string" wst:TypeHint="WideString"/>
   </message>
   <portType name="IEchoService">
-    <document>
+    <documentation>
       <GUID value="{FCD0F68F-3023-46C6-AD09-1DDA4A2989EB}"/>
-    </document>
+    </documentation>
     <operation name="EchoWideString">
       <input message="tns:EchoWideString"/>
       <output message="tns:EchoWideStringResponse"/>

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

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.