diff --git a/wst/trunk/tests/test_suite/files/complex_class_group10.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group10.wsdl
new file mode 100644
index 000000000..84e972017
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group10.wsdl
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/files/complex_class_group10.xsd b/wst/trunk/tests/test_suite/files/complex_class_group10.xsd
new file mode 100644
index 000000000..2a9a9324a
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group10.xsd
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/files/complex_class_group8.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group8.wsdl
new file mode 100644
index 000000000..c0885b5ec
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group8.wsdl
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/files/complex_class_group8.xsd b/wst/trunk/tests/test_suite/files/complex_class_group8.xsd
new file mode 100644
index 000000000..c2229234d
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group8.xsd
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/files/complex_class_group9.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group9.wsdl
new file mode 100644
index 000000000..0cda997fe
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group9.wsdl
@@ -0,0 +1,36 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/files/complex_class_group9.xsd b/wst/trunk/tests/test_suite/files/complex_class_group9.xsd
new file mode 100644
index 000000000..89ca383ed
--- /dev/null
+++ b/wst/trunk/tests/test_suite/files/complex_class_group9.xsd
@@ -0,0 +1,22 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas
index 80b98203e..aabf165fc 100644
--- a/wst/trunk/tests/test_suite/test_parsers.pas
+++ b/wst/trunk/tests/test_suite/test_parsers.pas
@@ -64,6 +64,9 @@ type
function LoadComplexType_Class_Group5() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Group6() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Group7() : TwstPasTreeContainer;virtual;abstract;
+ function LoadComplexType_Class_Group8() : TwstPasTreeContainer;virtual;
+ function LoadComplexType_Class_Group9() : TwstPasTreeContainer;virtual;
+ function LoadComplexType_Class_Group10() : TwstPasTreeContainer;virtual;
function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;virtual;abstract;
@@ -141,6 +144,9 @@ type
procedure ComplexType_Class_Group_use_forwarded_type();
procedure ComplexType_Class_Group_use_array();
procedure ComplexType_Class_Group_use_array_choice();
+ procedure ComplexType_Class_Group_ref_use_array();
+ procedure ComplexType_Class_Group_ref_use_array2();
+ procedure ComplexType_Class_Group_ref_use_array3();
procedure ComplexType_Class_AttGroup();
procedure ComplexType_Class_AttGroup_use();
procedure ComplexType_Class_AttGroup_use_forwarded();
@@ -435,6 +441,21 @@ begin
Result.DefaultSearchNameKinds := NAME_KINDS_DEFAULT;
end;
+function TTest_CustomXsdParser.LoadComplexType_Class_Group8() : TwstPasTreeContainer;
+begin
+ Result := ParseDoc('complex_class_group8');
+end;
+
+function TTest_CustomXsdParser.LoadComplexType_Class_Group9 : TwstPasTreeContainer;
+begin
+ Result := ParseDoc('complex_class_group9');
+end;
+
+function TTest_CustomXsdParser.LoadComplexType_Class_Group10 : TwstPasTreeContainer;
+begin
+ Result := ParseDoc('complex_class_group10');
+end;
+
function TTest_CustomXsdParser.load_att_inherited_maxbound : TwstPasTreeContainer;
begin
Result := ParseDoc('att_inherited_maxbound');
@@ -2029,6 +2050,276 @@ begin
end;
end;
+procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array();
+var
+ tr : TwstPasTreeContainer;
+ clsType : TPasClassType;
+
+ procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
+ var
+ prp : TPasProperty;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
+ CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+ end;
+
+ procedure CheckArrayProperty(const AName,ATypeName : string);
+ var
+ prp : TPasProperty;
+ at : TPasArrayType;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
+ at := prp.VarType as TPasArrayType;
+ CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
+ end;
+
+var
+ mdl : TPasModule;
+ ls : TList2;
+ elt : TPasElement;
+ i : Integer;
+ prpLs : TList;
+begin
+ tr := nil;
+ prpLs := TList.Create();
+ try
+ tr := LoadComplexType_Class_Group8();
+
+ mdl := tr.FindModule(x_targetNamespace);
+ CheckNotNull(mdl);
+ ls := mdl.InterfaceSection.Declarations;
+
+ elt := tr.FindElement('TContactGroupType');
+ CheckNotNull(elt,'TContactGroupType');
+ CheckEquals('TContactGroupType',elt.Name);
+ CheckEquals('TContactGroupType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals(3,prpLs.Count);
+ CheckProperty('firstName','string',ptField);
+ CheckProperty('lastName','string',ptField);
+ CheckProperty('Age','int',ptField);
+
+ elt := tr.FindElement('TClassSampleType');
+ CheckNotNull(elt,'TClassSampleType');
+ CheckEquals('TClassSampleType',elt.Name);
+ CheckEquals('TClassSampleType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals((2+3),prpLs.Count);
+ CheckProperty(x_intField,'int',ptField);
+ CheckProperty(x_strField,'string',ptAttribute);
+ CheckArrayProperty('firstName','string');
+ CheckArrayProperty('lastName','string');
+ CheckArrayProperty('Age','int');
+ finally
+ FreeAndNil(prpLs);
+ FreeAndNil(tr);
+ end;
+end;
+
+procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array2();
+var
+ tr : TwstPasTreeContainer;
+ clsType : TPasClassType;
+
+ procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
+ var
+ prp : TPasProperty;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
+ CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+ end;
+
+ procedure CheckArrayProperty(const AName,ATypeName : string);
+ var
+ prp : TPasProperty;
+ at : TPasArrayType;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
+ at := prp.VarType as TPasArrayType;
+ CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
+ end;
+
+var
+ mdl : TPasModule;
+ ls : TList2;
+ elt : TPasElement;
+ i : Integer;
+ prpLs : TList;
+begin
+ tr := nil;
+ prpLs := TList.Create();
+ try
+ tr := LoadComplexType_Class_Group9();
+
+ mdl := tr.FindModule(x_targetNamespace);
+ CheckNotNull(mdl);
+ ls := mdl.InterfaceSection.Declarations;
+
+ elt := tr.FindElement('TContactGroupType');
+ CheckNotNull(elt,'TContactGroupType');
+ CheckEquals('TContactGroupType',elt.Name);
+ CheckEquals('TContactGroupType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals(3,prpLs.Count);
+ CheckProperty('firstName','string',ptField);
+ CheckArrayProperty('lastName','string');
+ CheckProperty('Age','int',ptField);
+
+ elt := tr.FindElement('TClassSampleType');
+ CheckNotNull(elt,'TClassSampleType');
+ CheckEquals('TClassSampleType',elt.Name);
+ CheckEquals('TClassSampleType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals((2+3),prpLs.Count);
+ CheckProperty(x_intField,'int',ptField);
+ CheckProperty(x_strField,'string',ptAttribute);
+ CheckArrayProperty('firstName','string');
+ CheckArrayProperty('lastName','string');
+ CheckArrayProperty('Age','int');
+ finally
+ FreeAndNil(prpLs);
+ FreeAndNil(tr);
+ end;
+end;
+
+procedure TTest_CustomXsdParser.ComplexType_Class_Group_ref_use_array3();
+var
+ tr : TwstPasTreeContainer;
+ clsType : TPasClassType;
+
+ procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType);
+ var
+ prp : TPasProperty;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckEquals(ATypeName,tr.GetExternalName(prp.VarType));
+ CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+ end;
+
+ procedure CheckArrayProperty(const AName,ATypeName : string);
+ var
+ prp : TPasProperty;
+ at : TPasArrayType;
+ begin
+ prp := FindMember(clsType,AName) as TPasProperty;
+ CheckNotNull(prp);
+ CheckEquals(AName,prp.Name);
+ CheckEquals(AName,tr.GetExternalName(prp));
+ CheckNotNull(prp.VarType);
+ CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.');
+ at := prp.VarType as TPasArrayType;
+ CheckEquals(ATypeName,tr.GetExternalName(at.ElType));
+ end;
+
+var
+ mdl : TPasModule;
+ ls : TList2;
+ elt : TPasElement;
+ i : Integer;
+ prpLs : TList;
+begin
+ tr := nil;
+ prpLs := TList.Create();
+ try
+ tr := LoadComplexType_Class_Group10();
+
+ mdl := tr.FindModule(x_targetNamespace);
+ CheckNotNull(mdl);
+ ls := mdl.InterfaceSection.Declarations;
+
+ elt := tr.FindElement('TContactGroupType');
+ CheckNotNull(elt,'TContactGroupType');
+ CheckEquals('TContactGroupType',elt.Name);
+ CheckEquals('TContactGroupType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals(3,prpLs.Count);
+ CheckProperty('firstName','string',ptField);
+ CheckProperty('lastName','string',ptField);
+ CheckProperty('Age','int',ptAttribute);
+
+ elt := tr.FindElement('TClassSampleType');
+ CheckNotNull(elt,'TClassSampleType');
+ CheckEquals('TClassSampleType',elt.Name);
+ CheckEquals('TClassSampleType',tr.GetExternalName(elt));
+ CheckIs(elt,TPasClassType);
+ CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP);
+ clsType := elt as TPasClassType;
+ prpLs.Clear();
+ for i := 0 to Pred(clsType.Members.Count) do begin
+ if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then
+ prpLs.Add(clsType.Members[i]);
+ end;
+ CheckEquals((2+3),prpLs.Count);
+ CheckProperty(x_intField,'int',ptField);
+ CheckProperty(x_strField,'string',ptAttribute);
+ CheckArrayProperty('firstName','string');
+ CheckArrayProperty('lastName','string');
+ CheckProperty('Age','int',ptAttribute);
+ finally
+ FreeAndNil(prpLs);
+ FreeAndNil(tr);
+ end;
+end;
+
procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup();
var
tr : TwstPasTreeContainer;
diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas
index c39b570e0..f8c17cfc3 100644
--- a/wst/trunk/ws_helper/ws_parser_imp.pas
+++ b/wst/trunk/ws_helper/ws_parser_imp.pas
@@ -145,8 +145,17 @@ type
function IsHeaderBlock() : Boolean;
function IsSimpleContentHeaderBlock() : Boolean;
procedure SetAsGroupType(AType : TPasType; const AValue : Boolean);
- procedure AddGroup(ADest, AGroup : TPasClassType);
- procedure ParseGroups(AClassDef : TPasClassType; AGroupCursor : IObjectCursor);
+ procedure AddGroup(
+ ADest,
+ AGroup : TPasClassType;
+ const AMultiOccurrence : Boolean;
+ AArrayItems : TPropInfoReferenceList
+ );
+ procedure ParseGroups(
+ AClassDef : TPasClassType;
+ AGroupCursor : IObjectCursor;
+ AArrayItems : TPropInfoReferenceList
+ );
private
procedure CreateNodeCursors();
procedure ExtractTypeName();
@@ -187,6 +196,93 @@ implementation
uses
dom_cursors, parserutils, StrUtils, xsd_consts, wst_consts;
+type
+ TOccurrenceRec = record
+ Valid : Boolean;
+ MinOccurs : Integer;
+ MaxOccurs : Integer;
+ Unboundded : Boolean;
+ end;
+
+procedure ExtractOccurences(
+ AEntityName,
+ AItemName : string;
+ AAttCursor : IObjectCursor;
+ var AMinOccurs,
+ AMaxOccurs : Integer;
+ var AMaxUnboundded : Boolean
+);overload;
+var
+ locPartCursor : IObjectCursor;
+ locMin, locMax : Integer;
+ locMaxOccurUnbounded : Boolean;
+ locStrBuffer : string;
+begin
+ if (AAttCursor = nil) then begin
+ AMinOccurs := 1;
+ AMaxOccurs := 1;
+ AMaxUnboundded := False;
+ exit;
+ end;
+
+ locMin := 1;
+ locPartCursor :=
+ CreateCursorOn(
+ AAttCursor.Clone() as IObjectCursor,
+ ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),
+ TDOMNodeRttiExposer)
+ );
+ locPartCursor.Reset();
+ if locPartCursor.MoveNext() then begin
+ locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
+ if not TryStrToInt(locStrBuffer,locMin) then
+ raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[AEntityName,AItemName]);
+ if ( locMin < 0 ) then
+ raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[AEntityName,AItemName]);
+ end;
+
+ locMax := 1;
+ locMaxOccurUnbounded := False;
+ locPartCursor :=
+ CreateCursorOn(
+ AAttCursor.Clone() as IObjectCursor,
+ ParseFilter(
+ Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),
+ TDOMNodeRttiExposer
+ )
+ );
+ locPartCursor.Reset();
+ if locPartCursor.MoveNext() then begin
+ locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
+ if AnsiSameText(locStrBuffer,s_unbounded) then begin
+ locMaxOccurUnbounded := True;
+ end else begin
+ if not TryStrToInt(locStrBuffer,locMax) then
+ raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[AEntityName,AItemName]);
+ if ( locMin < 0 ) then
+ raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[AEntityName,AItemName]);
+ end;
+ end;
+
+ AMinOccurs := locMin;
+ AMaxOccurs := locMax;
+ AMaxUnboundded := locMaxOccurUnbounded;
+end;
+
+procedure ExtractOccurences(
+ AEntityName,
+ AItemName : string;
+ AAttCursor : IObjectCursor;
+ var AResult : TOccurrenceRec
+);overload;
+begin
+ ExtractOccurences(
+ AEntityName,AItemName,AAttCursor,
+ AResult.MinOccurs,AResult.MaxOccurs,AResult.Unboundded
+ );
+ AResult.Valid := True;
+end;
+
{ TAbstractTypeParser }
constructor TAbstractTypeParser.Create(
@@ -734,34 +830,52 @@ begin
FSymbols.Properties.SetValue(AType,sIS_GROUP,s);
end;
-procedure TComplexTypeParser.AddGroup(ADest, AGroup: TPasClassType);
+function MakeUniqueMemberName(
+ ABaseName : string;
+ AParent : TPasClassType;
+ ASuffix : string
+) : string;
var
- i, k : Integer;
+ locInternalEltName : string;
+ k : Integer;
+begin
+ locInternalEltName := ABaseName;
+ if (FindMember(AParent,locInternalEltName) <> nil) then begin
+ k := 0;
+ while True do begin
+ locInternalEltName := Format('%s%s',[ABaseName,ASuffix]);
+ if (k > 0) then
+ locInternalEltName := locInternalEltName+IntToStr(k);
+ if (FindMember(AParent,locInternalEltName) = nil) then
+ break;
+ k := k+1;
+ end;
+ end;
+ Result := locInternalEltName;
+end;
+
+procedure TComplexTypeParser.AddGroup(
+ ADest,
+ AGroup : TPasClassType;
+ const AMultiOccurrence : Boolean;
+ AArrayItems : TPropInfoReferenceList
+);
+var
+ i : Integer;
src, dest : TPasProperty;
locIsAttribute, locHasInternalName : Boolean;
- locInternalEltName : string;
+ locInternalEltName, locStrBuffer : string;
begin
for i := 0 to AGroup.Members.Count-1 do begin
if TObject(AGroup.Members[i]).InheritsFrom(TPasProperty) then begin
src := TPasProperty(AGroup.Members[i]);
- locHasInternalName := False;
locIsAttribute := FSymbols.IsAttributeProperty(src);
- locInternalEltName := src.Name;
- if (FindMember(ADest,locInternalEltName) <> nil) then begin
- locHasInternalName := True;
- k := 0;
- while True do begin
- if locIsAttribute then
- locInternalEltName := Format('%sAtt',[src.Name])
- else
- locInternalEltName := Format('%sElt',[src.Name]);
- if (k > 0) then
- locInternalEltName := locInternalEltName+IntToStr(k);
- if (FindMember(ADest,locInternalEltName) = nil) then
- break;
- k := k+1;
- end;
- end;
+ if locIsAttribute then
+ locStrBuffer := 'Att'
+ else
+ locStrBuffer := 'Elt';
+ locInternalEltName := MakeUniqueMemberName(src.Name,ADest,locStrBuffer);
+ locHasInternalName := not SameText(src.Name,locInternalEltName);
dest := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,ADest,visPublished,'',0));
ADest.Members.Add(dest);
dest.VarType := src.VarType;
@@ -781,6 +895,11 @@ begin
FSymbols.SetPropertyAsAttribute(dest,True);
if FSymbols.IsChoiceProperty(src) then
FSymbols.SetPropertyAsChoice(dest,True);
+ if not(locIsAttribute) and AMultiOccurrence and
+ (AArrayItems <> nil) and not(dest.VarType.InheritsFrom(TPasArrayType))
+ then begin
+ AArrayItems.Add(dest);
+ end;
{$IFDEF HAS_EXP_TREE}
if (src.DefaultExpr <> nil) and
src.DefaultExpr.InheritsFrom(TPrimitiveExpr)
@@ -795,7 +914,8 @@ end;
procedure TComplexTypeParser.ParseGroups(
AClassDef : TPasClassType;
- AGroupCursor : IObjectCursor
+ AGroupCursor : IObjectCursor;
+ AArrayItems : TPropInfoReferenceList
);
var
locNode : TDOMNode;
@@ -803,8 +923,12 @@ var
s, locNS, locLN, locLongNS : string;
elt : TPasElement;
locParser : IXsdPaser;
+ locOccurrenceInfos : TOccurrenceRec;
+ locMultiOccurrence : Boolean;
begin
if (AGroupCursor <> nil) then begin
+ FillChar(locOccurrenceInfos,SizeOf(locOccurrenceInfos),#0);
+ locMultiOccurrence := False;
AGroupCursor.Reset();
while AGroupCursor.MoveNext() do begin
locNode := (AGroupCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
@@ -829,7 +953,13 @@ begin
if (elt <> nil) then begin
if not elt.InheritsFrom(TPasClassType) then
raise EXsdInvalidElementDefinitionException.CreateFmt(SERR_UnableToResolveGroupRef,[FTypeName,elt.Name]);
- AddGroup(AClassDef,elt as TPasClassType)
+ if (AArrayItems <> nil) then begin
+ ExtractOccurences(AClassDef.Name,elt.Name,locAttCursor,locOccurrenceInfos);
+ locMultiOccurrence :=
+ locOccurrenceInfos.Valid and
+ (locOccurrenceInfos.Unboundded or (locOccurrenceInfos.MaxOccurs > 1));
+ end;
+ AddGroup(AClassDef,elt as TPasClassType,locMultiOccurrence,AArrayItems);
end;
end
end;
@@ -997,14 +1127,6 @@ begin
end;
end;
-type
- TOccurrenceRec = record
- Valid : Boolean;
- MinOccurs : Integer;
- MaxOccurs : Integer;
- Unboundded : Boolean;
- end;
-
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType;
var
classDef : TPasClassType;
@@ -1018,57 +1140,6 @@ var
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
- procedure ExtractOccurences(
- AItemName : string;
- AAttCursor : IObjectCursor;
- var AMinOccurs,
- AMaxOccurs : Integer;
- var AMaxUnboundded : Boolean
- );
- var
- locPartCursor : IObjectCursor;
- locMin, locMax : Integer;
- locMaxOccurUnbounded : Boolean;
- locStrBuffer : string;
- begin
- if (AAttCursor = nil) then begin
- AMinOccurs := 1;
- AMaxOccurs := 1;
- AMaxUnboundded := False;
- exit;
- end;
-
- locMin := 1;
- locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
- locPartCursor.Reset();
- if locPartCursor.MoveNext() then begin
- if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMin) then
- raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]);
- if ( locMin < 0 ) then
- raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]);
- end;
-
- locMax := 1;
- locMaxOccurUnbounded := False;
- locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
- locPartCursor.Reset();
- if locPartCursor.MoveNext() then begin
- locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
- if AnsiSameText(locStrBuffer,s_unbounded) then begin
- locMaxOccurUnbounded := True;
- end else begin
- if not TryStrToInt(locStrBuffer,locMax) then
- raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]);
- if ( locMin < 0 ) then
- raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]);
- end;
- end;
-
- AMinOccurs := locMin;
- AMaxOccurs := locMax;
- AMaxUnboundded := locMaxOccurUnbounded;
- end;
-
procedure ParseElement(
AElement : TDOMNode;
const ABoundInfos : TOccurrenceRec;
@@ -1332,7 +1403,7 @@ var
if (locEltCrs <> nil) then begin
locEltAttCrs := CreateAttributesCursor(locNode,cetRttiNode);
FillChar(locBoundInfos,SizeOf(locBoundInfos),#0);
- ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
+ ExtractOccurences(FTypeName,s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
ParseElementsAndAttributes(locEltCrs,nil,locBoundInfos,True);
@@ -1467,7 +1538,7 @@ begin
locTempNode := locTempNode.ParentNode;
if (ExtractNameFromQName(locTempNode.NodeName) = s_choice) then begin
ExtractOccurences(
- s_choice,
+ FTypeName,s_choice,
CreateAttributesCursor(locTempNode,cetRttiNode),
locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded
);
@@ -1478,8 +1549,8 @@ begin
end;
end;
ParseElementsAndAttributes(eltCrs,eltAttCrs,locBoundInfos,locIsChoiceParent);
- ParseGroups(classDef,grpCrs);
- ParseGroups(classDef,attGrpCrs);
+ ParseGroups(classDef,grpCrs,arrayItems);
+ ParseGroups(classDef,attGrpCrs,nil);
if ( arrayItems.GetCount() > 0 ) then begin
if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and
( GetElementCount(classDef.Members,TPasProperty) = 1 )