XSD/WSDL parser, "group" construct : On "ref" site multiple occurrence handling + tests.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5013 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
parent
59719d29cb
commit
b8b487e621
36
wst/trunk/tests/test_suite/files/complex_class_group10.wsdl
Normal file
36
wst/trunk/tests/test_suite/files/complex_class_group10.wsdl
Normal 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
22
wst/trunk/tests/test_suite/files/complex_class_group10.xsd
Normal 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
36
wst/trunk/tests/test_suite/files/complex_class_group8.wsdl
Normal 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
22
wst/trunk/tests/test_suite/files/complex_class_group8.xsd
Normal 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
36
wst/trunk/tests/test_suite/files/complex_class_group9.wsdl
Normal 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
22
wst/trunk/tests/test_suite/files/complex_class_group9.xsd
Normal 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>
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
src, dest : TPasProperty;
|
||||
locIsAttribute, locHasInternalName : Boolean;
|
||||
locInternalEltName : string;
|
||||
k : Integer;
|
||||
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;
|
||||
locInternalEltName := ABaseName;
|
||||
if (FindMember(AParent,locInternalEltName) <> nil) then begin
|
||||
k := 0;
|
||||
while True do begin
|
||||
if locIsAttribute then
|
||||
locInternalEltName := Format('%sAtt',[src.Name])
|
||||
else
|
||||
locInternalEltName := Format('%sElt',[src.Name]);
|
||||
locInternalEltName := Format('%s%s',[ABaseName,ASuffix]);
|
||||
if (k > 0) then
|
||||
locInternalEltName := locInternalEltName+IntToStr(k);
|
||||
if (FindMember(ADest,locInternalEltName) = nil) then
|
||||
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, 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]);
|
||||
locIsAttribute := FSymbols.IsAttributeProperty(src);
|
||||
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 )
|
||||
|
||||
Loading…
Reference in New Issue
Block a user