composed name handling (such as "one-prop")

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

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

@@ -0,0 +1,22 @@
+<?xml version="1.0"?>
+<definitions name="wst_test" 
+   xmlns="http://schemas.xmlsoap.org/wsdl/" 
+   xmlns:tns="urn_sample" 
+   xmlns:xsd="http://www.w3.org/2001/XMLSchema" 
+   xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" 
+   targetNamespace="urn_sample"
+   xmlns:wst="urn:wst_base">
+
+  <types>
+    <xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn_sample">
+      <xsd:complexType name="TSampleClass">
+        <xsd:sequence>
+          <xsd:element name="one-prop" type="xsd:string" />
+        </xsd:sequence>
+        <xsd:attribute name="one-two-prop" type="xsd:string"/>
+      </xsd:complexType>        
+    </xsd:schema>
+  </types>
+  
+
+</definitions>

wst/trunk/tests/test_suite/files/class_property_composed_name.xsd

@@ -0,0 +1,8 @@
+<schema targetNamespace="urn_sample" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="urn_sample" xmlns:wst="urn:wst_base">
+  <xsd:complexType name="TSampleClass">
+    <xsd:sequence>
+      <xsd:element name="one-prop" type="xsd:string" />
+    </xsd:sequence>
+    <xsd:attribute name="one-two-prop" type="xsd:string"/>
+  </xsd:complexType>
+</schema>

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

@@ -0,0 +1,51 @@
+<?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="one-param" type="xsd:string"/>
+    <part name="one-two-param" type="xsd:string"/>
+  </message>
+  <message name="sampleProcResponse" />
+  <message name="sampleFuncResponse">
+    <part name="one-two-param" type="xsd:string"/>
+    <part name="result" type="xsd:string"/>
+  </message>  
+  <portType name="TestService">
+    <operation name="sampleProc">
+      <input message="tns:sampleProc"/>
+      <output message="tns:sampleProcResponse"/>
+    </operation>
+    <operation name="sampleFunc">
+      <input message="tns:sampleProc"/>
+      <output message="tns:sampleFuncResponse"/>
+    </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="sampleFunc">
+      <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

@@ -61,6 +61,7 @@ type
     function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract;
     function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract;
     function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract;
+    function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract;
 
     function load_schema_import() : TwstPasTreeContainer;virtual;abstract;
   published
@@ -100,6 +101,7 @@ type
     procedure class_ansichar_property();
     procedure class_widechar_property();
     procedure class_currency_property();
+    procedure class_property_composed_name();
 
     procedure schema_import();
   end;
@@ -143,6 +145,7 @@ type
     function load_class_ansichar_property() : TwstPasTreeContainer;override;
     function load_class_widechar_property() : TwstPasTreeContainer;override;
     function load_class_currency_property() : TwstPasTreeContainer;override;
+    function load_class_property_composed_name() : TwstPasTreeContainer;override;
 
     function load_schema_import() : TwstPasTreeContainer;override;
   end;
@@ -185,7 +188,8 @@ type
     function load_class_widestring_property() : TwstPasTreeContainer;override;
     function load_class_ansichar_property() : TwstPasTreeContainer;override;
     function load_class_widechar_property() : TwstPasTreeContainer;override;
-    function load_class_currency_property() : TwstPasTreeContainer;override;
+    function load_class_currency_property() : TwstPasTreeContainer;override;  
+    function load_class_property_composed_name() : TwstPasTreeContainer;override;
 
     function load_schema_import() : TwstPasTreeContainer;override;
   published
@@ -198,6 +202,8 @@ type
     procedure message_parts_type_hint();
     procedure parameter_var();
     procedure parameter_const_default();
+    procedure parameter_composed_name();
+    procedure parameter_composed_name_function();
     procedure soap_action();
   end;
   
@@ -1913,6 +1919,49 @@ begin
   end;
 end;
 
+procedure TTest_CustomXsdParser.class_property_composed_name();   
+const s_class_name = 'TSampleClass';
+var
+  clsType : TPasClassType;
+  tr : TwstPasTreeContainer;
+
+  procedure CheckProperty(
+    const AName,
+          ADeclaredName,
+          ATypeName      : string; 
+    const AFieldType     : TPropertyType
+  );
+  var
+    prp : TPasProperty;
+  begin
+    prp := FindMember(clsType,AName) as TPasProperty;
+      CheckNotNull(prp);
+      CheckEquals(AName,prp.Name,'Name');
+      CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
+      CheckNotNull(prp.VarType);
+      CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
+      CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+  end;
+
+var
+  mdl : TPasModule;
+  elt : TPasElement;
+begin
+  tr := load_class_property_composed_name();
+  try
+    mdl := tr.FindModule('urn_sample');
+    CheckNotNull(mdl,'urn_sample');
+    elt := tr.FindElement(s_class_name);
+      CheckNotNull(elt,s_class_name);       
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckProperty('one_prop','one-prop','string',ptField);
+      CheckProperty('one_two_prop','one-two-prop','string',ptAttribute);
+  finally
+    tr.Free();
+  end;   
+end;
+
 procedure TTest_CustomXsdParser.schema_import();
 const
   s_base_namespace = 'urn:base-library';
@@ -2094,6 +2143,11 @@ begin
   Result := ParseDoc('class_currency_property');    
 end;
 
+function TTest_XsdParser.load_class_property_composed_name() : TwstPasTreeContainer;  
+begin
+  Result := ParseDoc('class_property_composed_name');  
+end;
+
 function TTest_XsdParser.load_schema_import(): TwstPasTreeContainer;
 begin
   Result := ParseDoc('import_second_library');
@@ -2666,6 +2720,109 @@ begin
   end;
 end;
 
+procedure TTest_WsdlParser.parameter_composed_name(); 
+
+  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_composed_name');
+  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('one_param',arg.Name,'Param Name');
+        CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
+      arg := TPasArgument(mthType.Args[1]);
+        CheckNotNull(arg);
+        CheckEquals('one_two_param',arg.Name,'Param Name');
+        CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
+  finally
+    tr.Free();
+  end;
+end;
+
+procedure TTest_WsdlParser.parameter_composed_name_function();
+
+  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_composed_name');
+  try
+    elt := tr.FindElement('TestService');
+    CheckNotNull(elt,'TestService');
+    CheckIs(elt,TPasClassType);
+    intf := elt as TPasClassType;
+    CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
+    mth := FindProc('sampleFunc',intf);
+      CheckNotNull(mth,'sampleFunc not found');
+      CheckEquals('sampleFunc',mth.Name);
+      mthType := mth.ProcType;
+      CheckIs(mthType,TPasFunctionType);
+      CheckEquals(2, mthType.Args.Count, 'Parameter count');
+      arg := TPasArgument(mthType.Args[0]);
+        CheckNotNull(arg);
+        CheckEquals('one_param',arg.Name,'Param Name');
+        CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
+      arg := TPasArgument(mthType.Args[1]);
+        CheckNotNull(arg);
+        CheckEquals('one_two_param',arg.Name,'Param Name');
+        CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
+      res := TPasFunctionType(mthType).ResultEl;
+        CheckNotNull(res, 'Result');
+        CheckEquals(LowerCase('string'), LowerCase(res.ResultType.Name));
+  finally
+    tr.Free();
+  end;
+end;
+
 procedure TTest_WsdlParser.soap_action(); 
 var
   tr : TwstPasTreeContainer;
@@ -2728,6 +2885,11 @@ begin
   Result := ParseDoc('class_currency_property');
 end;
 
+function TTest_WsdlParser.load_class_property_composed_name() : TwstPasTreeContainer;  
+begin
+  Result := ParseDoc('class_property_composed_name');  
+end;
+
 function TTest_WsdlParser.load_schema_import(): TwstPasTreeContainer;
 begin
   Result := ParseDoc('import_second_library');

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -902,10 +902,12 @@ var
         FSymbols.RegisterExternalAlias(locType,locTypeName);
     end;
     
-    locInternalEltName := locName;
+    locInternalEltName := ExtractIdentifier(locName);
-    locHasInternalName := IsReservedKeyWord(locInternalEltName);
+    locHasInternalName := (locInternalEltName <> locName);
-    if locHasInternalName then
+    if IsReservedKeyWord(locInternalEltName) then begin
+      locHasInternalName := True; 
       locInternalEltName := Format('_%s',[locInternalEltName]);
+    end;
 
     locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
     classDef.Members.Add(locProp);

wst/trunk/ws_helper/wsdl_parser.pas

@@ -618,6 +618,7 @@ function TWsdlParser.ParseOperation(
                 then begin
                   prmInternameName := prmInternameName + 'Param';
                 end;
+                prmInternameName := ExtractIdentifier(prmInternameName);
                 prmHasInternameName := IsReservedKeyWord(prmInternameName) or
                                        ( not IsValidIdent(prmInternameName) ) or
                                        ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
@@ -742,6 +743,7 @@ function TWsdlParser.ParseOperation(
               if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
                 prmInternameName := prmInternameName + 'Param';
               end;
+              prmInternameName := ExtractIdentifier(prmInternameName);
               prmHasInternameName := IsReservedKeyWord(prmInternameName) or
                                      ( not IsValidIdent(prmInternameName) );
               if prmHasInternameName then