WSDL Parser : fix "var" parameter parsing

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@800 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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

@@ -0,0 +1,62 @@
+<?xml version="1.0"?>
+<definitions name="library1" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="library1" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="library1">
+  <types>
+    <xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:tns="library1" targetNamespace="library1"/>
+  </types>
+  
+  <message name="sampleProc">
+    <part name="AInParam" type="xsd:string"/>
+    <part name="AInOutParam" type="xsd:int"/>
+  </message>
+  <message name="sampleProcResponse">
+    <part name="AInOutParam" type="xsd:int"/>
+  </message>
+  
+  <message name="sampleProc2">
+    <part name="AInParam" type="xsd:string"/>
+    <part name="AInOutParam" type="xsd:int"/>
+  </message>
+  <message name="sampleProc2Response">
+    <part name="AInOutParam" type="xsd:byte"/>
+  </message>
+    
+  <portType name="TestService">
+    <document>
+      <GUID value="{061EA53B-871D-45AE-9714-33EFF4069818}"/>
+    </document>
+    <operation name="sampleProc">
+      <input message="tns:sampleProc"/>
+      <output message="tns:sampleProcResponse"/>
+    </operation>
+    <operation name="sampleProc2">
+      <input message="tns:sampleProc2"/>
+      <output message="tns:sampleProc2Response"/>
+    </operation>    
+  </portType>
+  <binding name="TestServiceBinding" type="tns:TestService">
+    <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
+    <operation name="sampleProc">
+      <soap:operation soapAction=""/>
+      <input>
+        <soap:body use="literal" namespace="library1"/>
+      </input>
+      <output>
+        <soap:body use="literal" namespace="library1"/>
+      </output>
+    </operation>
+    <operation name="sampleProc2">
+      <soap:operation soapAction=""/>
+      <input>
+        <soap:body use="literal" namespace="library1"/>
+      </input>
+      <output>
+        <soap:body use="literal" namespace="library1"/>
+      </output>
+    </operation>    
+  </binding>
+  <service name="TestService">
+    <port name="TestServicePort" binding="tns:TestServiceBinding">
+      <soap:address location=""/>
+    </port>
+  </service>
+</definitions>

wst/trunk/tests/test_suite/test_parsers.pas

@@ -176,10 +176,11 @@ type
     procedure xsd_not_declared_at_top_node();
     procedure xsd_not_declared_at_top_node_2();
     procedure message_parts_type_hint();
+    procedure var_parameter();
   end;
   
 implementation
-uses parserutils, xsd_consts;
+uses parserutils, xsd_consts, typinfo;
 
 const
   x_complexType_SampleArrayIntFieldType     = 'TArrayIntFieldType';
@@ -2260,6 +2261,76 @@ begin
   end;
 end;
 
+procedure TTest_WsdlParser.var_parameter();
+
+  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('var_parameter');
+  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(2, mthType.Args.Count, 'Parameter count');
+      arg := TPasArgument(mthType.Args[0]);
+        CheckNotNull(arg);
+        CheckEquals(LowerCase('AInParam'), LowerCase(arg.Name));
+        CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name));
+      arg := TPasArgument(mthType.Args[1]);
+        CheckNotNull(arg);
+        CheckEquals(LowerCase('AInOutParam'), LowerCase(arg.Name));
+        CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
+        CheckEquals('argVar',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'arg.Access');
+
+    mth := FindProc('sampleProc2',intf);
+      CheckNotNull(mth,'sampleProc2 not found');
+      CheckEquals('sampleProc2',mth.Name);
+      mthType := mth.ProcType;
+      CheckIs(mthType,TPasFunctionType);
+        res := TPasFunctionType(mthType).ResultEl;
+        CheckNotNull(res, 'Result');
+        CheckEquals(LowerCase('ShortInt'), LowerCase(res.ResultType.Name));
+      CheckEquals(2, mthType.Args.Count, 'Parameter count');
+      arg := TPasArgument(mthType.Args[0]);
+        CheckNotNull(arg);
+        CheckEquals(LowerCase('AInParam'), LowerCase(arg.Name));
+        CheckEquals(LowerCase('string'), LowerCase(arg.ArgType.Name));
+      arg := TPasArgument(mthType.Args[1]);
+        CheckNotNull(arg);
+        CheckEquals(LowerCase('AInOutParam'), LowerCase(arg.Name));
+        CheckEquals(LowerCase('integer'), LowerCase(arg.ArgType.Name));
+        CheckEquals('argConst',GetEnumName(TypeInfo(TArgumentAccess),Ord(arg.Access)),'arg.Access');
+  finally
+    tr.Free();
+  end;
+end;
+
 function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
 begin
   Result := ParseDoc(x_complexType_class_default);

wst/trunk/ws_helper/wsdl_parser.pas

@@ -607,6 +607,8 @@ function TWsdlParser.ParseOperation(
       j : PtrInt;
       arg_a, arg_b : TPasArgument;
       resArgIndex : PtrInt;
+      prmNameColisionWithInputParam : Boolean;
+      prmTypeEntity : TPasType;
     begin
       if ExtractMsgName(s_output,outMsg) then begin
         outMsgNode := FindMessageNode(outMsg);
@@ -647,28 +649,29 @@ function TWsdlParser.ParseOperation(
                 prmInternameName := prmInternameName + 'Param';
               end;
               prmHasInternameName := IsReservedKeyWord(prmInternameName) or
-                                     ( not IsValidIdent(prmInternameName) ) or
-                                     ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
+                                     ( not IsValidIdent(prmInternameName) );
               if prmHasInternameName then
                 prmInternameName := '_' + prmInternameName;
+              prmNameColisionWithInputParam := ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
+              prmTypeEntity := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode));
               prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
               prmDef := FindParameter(tmpMthdType,prmInternameName);
               if ( prmDef = nil ) then begin
                 prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
                 tmpMthdType.Args.Add(prmDef);
-                prmDef.ArgType := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode));
+                prmDef.ArgType := prmTypeEntity;
                 prmDef.ArgType.AddRef();
                 prmDef.Access := argOut;
                 if prmHasInternameName then begin
                   SymbolTable.RegisterExternalAlias(prmDef,prmName);
                 end;
               end else begin
-                if SymbolTable.SameName(prmDef.ArgType,prmTypeName) then begin
+                if prmNameColisionWithInputParam and ( prmDef.ArgType = prmTypeEntity ) then begin
                   prmDef.Access := argVar;
                 end else begin
                   prmInternameName := '_' + prmInternameName;
                   prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0));
-                  prmDef.ArgType := GetDataType(prmTypeName,prmTypeType,ExtractTypeHint(tmpNode));
+                  prmDef.ArgType := prmTypeEntity;
                   prmDef.ArgType.AddRef();
                   prmDef.Access := argOut;
                   tmpMthdType.Args.Add(prmDef);