paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

XSD/WSDL parser, "group" construct : On "ref" site multiple occurrence handling + tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5013 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2016-07-20 19:41:11 +00:00
parent 59719d29cb
commit b8b487e621
8 changed files with 623 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
wst/trunk/tests/test_suite/files/complex_class_group10.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
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="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
</xsd:sequence>
<xsd:attribute name="Age" type="xsd:int"/>
</xsd:group>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group10.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
</xsd:sequence>
<xsd:attribute name="Age" type="xsd:int"/>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

36
wst/trunk/tests/test_suite/files/complex_class_group8.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
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="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group8.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

36
wst/trunk/tests/test_suite/files/complex_class_group9.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
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="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group9.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

291
wst/trunk/tests/test_suite/test_parsers.pas
View File

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

245
wst/trunk/ws_helper/ws_parser_imp.pas
View File

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