<choice> construct parsing : Fix for unbounded embedded cases.

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

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

@@ -0,0 +1,48 @@
+<?xml version="1.0"?>
+<definitions name="wst_test" 
+   xmlns="http://schemas.xmlsoap.org/wsdl/" 
+   xmlns:tns="library1" 
+   xmlns:xs="http://www.w3.org/2001/XMLSchema" 
+   xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" 
+   targetNamespace="urn:wst-test">
+
+  <types>
+    <xs:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
+            
+          <xs:element name="EntityContainer">
+            <xs:complexType>
+              <xs:sequence>  
+                <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+                <xs:choice minOccurs="0" maxOccurs="unbounded">
+                  <xs:element name="FunctionImport">
+                    <xs:complexType>
+                      <xs:sequence>
+                          <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+                          <xs:choice minOccurs="0" maxOccurs="unbounded">
+                            <xs:element name="ReturnType" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                            <xs:element name="Parameter" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                          </xs:choice>
+                      </xs:sequence>
+                    </xs:complexType>
+                  </xs:element>
+                  <xs:element name="EntitySet">
+                    <xs:complexType>
+                      <xs:sequence>
+                          <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+                          <xs:choice minOccurs="0" maxOccurs="unbounded">
+                            <xs:element name="ValueAnnotation" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                            <xs:element name="TypeAnnotation" type="xs:integer" minOccurs="0" maxOccurs="unbounded" />
+                          </xs:choice>
+                      </xs:sequence>
+                    </xs:complexType>
+                  </xs:element>
+                </xs:choice>
+              </xs:sequence>  
+            </xs:complexType>
+          </xs:element>
+  
+    </xs:schema>
+  </types>
+  
+
+</definitions>

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

@@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="UTF-8"?>
+ <xs:schema xmlns:n="urn:wst-test" 
+  xmlns:xs="http://www.w3.org/2001/XMLSchema" 
+  targetNamespace="urn:wst-test">
+  
+
+  <xs:element name="EntityContainer">
+    <xs:complexType>
+      <xs:sequence>  
+        <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+        <xs:choice minOccurs="0" maxOccurs="unbounded">
+          <xs:element name="FunctionImport">
+            <xs:complexType>
+              <xs:sequence>
+                  <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+                  <xs:choice minOccurs="0" maxOccurs="unbounded">
+                    <xs:element name="ReturnType" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                    <xs:element name="Parameter" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                  </xs:choice>
+              </xs:sequence>
+            </xs:complexType>
+          </xs:element>
+          <xs:element name="EntitySet">
+            <xs:complexType>
+              <xs:sequence>
+                  <xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
+                  <xs:choice minOccurs="0" maxOccurs="unbounded">
+                    <xs:element name="ValueAnnotation" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
+                    <xs:element name="TypeAnnotation" type="xs:integer" minOccurs="0" maxOccurs="unbounded" />
+                  </xs:choice>
+              </xs:sequence>
+            </xs:complexType>
+          </xs:element>
+        </xs:choice>
+      </xs:sequence>  
+    </xs:complexType>
+  </xs:element>
+  
+ </xs:schema>

wst/trunk/tests/test_suite/test_parsers.pas

@@ -109,6 +109,7 @@ type
 
     function load_global_attribute() : TwstPasTreeContainer;virtual;abstract;
     function load_att_inherited_maxbound() : TwstPasTreeContainer;virtual;
+    function load_embedded_unbounded_choice() : TwstPasTreeContainer;virtual;
   published
     procedure EmptySchema();
 
@@ -183,6 +184,7 @@ type
 
     procedure global_attribute();
     procedure att_inherited_maxbound();
+    procedure embedded_unbounded_choice();
   end;
 
   { TTest_XsdParser }
@@ -438,6 +440,11 @@ begin
   Result := ParseDoc('att_inherited_maxbound');
 end;
 
+function TTest_CustomXsdParser.load_embedded_unbounded_choice : TwstPasTreeContainer;
+begin
+  Result := ParseDoc('embedded_unbounded_choice');
+end;
+
 procedure TTest_CustomXsdParser.EmptySchema();
 var
   tr : TwstPasTreeContainer;
@@ -4145,6 +4152,79 @@ begin
   end;
 end;
 
+procedure TTest_CustomXsdParser.embedded_unbounded_choice();
+const s_class_name = 'EntityContainer';
+var
+  clsType : TPasClassType;
+  tr : TwstPasTreeContainer;
+
+  procedure CheckProperty(
+    const AName,
+          ADeclaredName,
+          ATypeName      : string;
+    const AFieldType     : TPropertyType;
+    const AIsArray       : Boolean
+  );
+  var
+    prp : TPasProperty;
+    t : TPasType;
+  begin
+    prp := FindMember(clsType,AName) as TPasProperty;
+      CheckNotNull(prp);
+      CheckEquals(AName,prp.Name,'Name');
+      CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
+      CheckNotNull(prp.VarType);
+      t := GetUltimeType(prp.VarType);
+      CheckNotNull(t,'Property''s Ultime Type not found.');
+      if AIsArray then begin
+        CheckEquals(AIsArray,(t is TPasArrayType));
+        CheckNotNull(TPasArrayType(t).ElType,'array element type');
+        CheckEquals(ATypeName,tr.GetExternalName(TPasArrayType(t).ElType),'TypeName');
+      end else begin
+        CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
+      end;
+      CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+  end;
+
+var
+  mdl : TPasModule;
+  elt : TPasElement;
+  s : string;
+begin
+  tr := load_embedded_unbounded_choice();
+  try
+    mdl := tr.FindModule('urn:wst-test');
+    CheckNotNull(mdl,'urn:wst-test');
+    elt := tr.FindElement(s_class_name);
+      CheckNotNull(elt,s_class_name);
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckProperty('Documentation','Documentation','string',ptField,False);
+      CheckProperty('FunctionImport','FunctionImport','EntityContainer_FunctionImport_Type',ptField,True);
+      CheckProperty('EntitySet','EntitySet','EntityContainer_EntitySet_Type',ptField,True);
+
+    s := 'EntityContainer_FunctionImport_Type';
+    elt := tr.FindElement(s);
+      CheckNotNull(elt,s);
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckProperty('Documentation','Documentation','string',ptField,False);
+      CheckProperty('ReturnType','ReturnType','string',ptField,True);
+      CheckProperty('Parameter','Parameter','string',ptField,True);
+
+    s := 'EntityContainer_EntitySet_Type';
+    elt := tr.FindElement(s);
+      CheckNotNull(elt,s);
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckProperty('Documentation','Documentation','string',ptField,False);
+      CheckProperty('ValueAnnotation','ValueAnnotation','string',ptField,True);
+      CheckProperty('TypeAnnotation','TypeAnnotation','integer',ptField,True);
+  finally
+    tr.Free();
+  end;
+end;
+
 { TTest_XsdParser }
 
 function TTest_XsdParser.ParseDoc(

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -1330,10 +1330,12 @@ var
         if (locLN = s_choice) then begin
           locEltCrs := ExtractElement(locNode);
           if (locEltCrs <> nil) then begin
+            locEltAttCrs := CreateAttributesCursor(locNode,cetRttiNode);
+            FillChar(locBoundInfos,SizeOf(locBoundInfos),#0);
             ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
             locBoundInfos.MinOccurs := 0;
             locBoundInfos.Valid := True;
-            ParseElementsAndAttributes(locEltCrs,locEltAttCrs,locBoundInfos,AIsChoiceParent);
+            ParseElementsAndAttributes(locEltCrs,nil,locBoundInfos,True);
           end;
         end else begin
           ParseElement(locNode,ABoundInfos,AIsChoiceParent);