pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

xsd's "choice" construct parsing + tests

Browse Source 
parser is case sensitive  b default now, + tests

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1942 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2011-09-14 02:31:02 +00:00
parent b0272c01fd
commit fc1c449cd2
20 changed files with 1181 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
wst/trunk/tests/test_suite/files/case_sensitive.wsdl Normal file
View File

@@ -0,0 +1,40 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xsd:simpleType name="String">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="Date">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="Boolean">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="dateField" type="xsd:date" />
<xsd:element name="localDateField" type="n:Date" minOccurs="1" maxOccurs="1" />
<xsd:element name="booleanField" type="xsd:boolean" />
<xsd:element name="localBooleanField" type="n:Boolean" minOccurs="1" maxOccurs="1" />
<xsd:element name="stringField" type="xsd:string" />
<xsd:element name="localStringField" type="n:String" />
</xsd:sequence>
<xsd:attribute name="dateAtt" type="xsd:date" />
<xsd:attribute name="localDateAtt" type="n:Date" />
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

31
wst/trunk/tests/test_suite/files/case_sensitive.xsd Normal file
View File

@@ -0,0 +1,31 @@
<?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:simpleType name="String">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="Date">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="Boolean">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="dateField" type="xsd:date" />
<xsd:element name="localDateField" type="n:Date" minOccurs="1" maxOccurs="1" />
<xsd:element name="booleanField" type="xsd:boolean" />
<xsd:element name="localBooleanField" type="n:Boolean" minOccurs="1" maxOccurs="1" />
<xsd:element name="stringField" type="xsd:string" />
<xsd:element name="localStringField" type="n:String" />
</xsd:sequence>
<xsd:attribute name="dateAtt" type="xsd:date" />
<xsd:attribute name="localDateAtt" type="n:Date" />
</xsd:complexType>
</xsd:schema>

32
wst/trunk/tests/test_suite/files/case_sensitive2.wsdl Normal file
View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xsd:simpleType name="SampleType">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="SAMPLETYPE">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="Field1" type="n:SampleType" />
<xsd:element name="Field2" type="n:SAMPLETYPE" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

21
wst/trunk/tests/test_suite/files/case_sensitive2.xsd Normal file
View File

@@ -0,0 +1,21 @@
<?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:simpleType name="SampleType">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="SAMPLETYPE">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="Field1" type="n:SampleType" />
<xsd:element name="Field2" type="n:SAMPLETYPE" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

42
wst/trunk/tests/test_suite/files/case_sensitive3.wsdl Normal file
View File

@@ -0,0 +1,42 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:wst-test3"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test3">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema"
xmlns:s="urn:wst-test"
targetNamespace="urn:wst-test3">
<xsd:import
namespace = "urn:wst-test"
schemaLocation = "case_sensitive2.xsd"
/>
<xsd:simpleType name="TypeA">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="TYPEA">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="CompoundType">
<xsd:sequence>
<xsd:element name="f1" type="s:SampleType" />
<xsd:element name="f2" type="s:SAMPLETYPE" />
<xsd:element name="f3" type="n:TypeA" />
<xsd:element name="f4" type="n:TYPEA" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

30
wst/trunk/tests/test_suite/files/case_sensitive3.xsd Normal file
View File

@@ -0,0 +1,30 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:s="urn:wst-test"
targetNamespace="urn:wst-test3">
<xsd:import
namespace = "urn:wst-test"
schemaLocation = "case_sensitive2.xsd"
/>
<xsd:simpleType name="TypeA">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:simpleType name="TYPEA">
<xsd:restriction base="xsd:string"/>
</xsd:simpleType>
<xsd:complexType name="CompoundType">
<xsd:sequence>
<xsd:element name="f1" type="s:SampleType" />
<xsd:element name="f2" type="s:SAMPLETYPE" />
<xsd:element name="f3" type="n:TypeA" />
<xsd:element name="f4" type="n:TYPEA" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/complex_class_choice.wsdl Normal file
View File

@@ -0,0 +1,27 @@
<?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="TSampleType1">
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

13
wst/trunk/tests/test_suite/files/complex_class_choice.xsd Normal file
View File

@@ -0,0 +1,13 @@
<?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:complexType name="TSampleType1">
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
</xsd:complexType>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/complex_class_choice2.wsdl Normal file
View File

@@ -0,0 +1,27 @@
<?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="TSampleType1">
<xsd:choice maxOccurs="unbounded">
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

13
wst/trunk/tests/test_suite/files/complex_class_choice2.xsd Normal file
View File

@@ -0,0 +1,13 @@
<?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:complexType name="TSampleType1">
<xsd:choice maxOccurs="unbounded">
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
</xsd:complexType>
</xsd:schema>

31
wst/trunk/tests/test_suite/files/complex_class_choice3.wsdl Normal file
View File

@@ -0,0 +1,31 @@
<?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="TSampleType1">
<xsd:sequence>
<xsd:element name="intField1" type="xsd:int" />
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
<xsd:element name="dateField" type="xsd:date" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

17
wst/trunk/tests/test_suite/files/complex_class_choice3.xsd Normal file
View File

@@ -0,0 +1,17 @@
<?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:complexType name="TSampleType1">
<xsd:sequence>
<xsd:element name="intField1" type="xsd:int" />
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
<xsd:element name="dateField" type="xsd:date" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

31
wst/trunk/tests/test_suite/files/complex_class_choice4.wsdl Normal file
View File

@@ -0,0 +1,31 @@
<?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="TSampleType1">
<xsd:sequence>
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
<xsd:element name="intField1" type="xsd:int" />
<xsd:element name="dateField" type="xsd:date" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

17
wst/trunk/tests/test_suite/files/complex_class_choice4.xsd Normal file
View File

@@ -0,0 +1,17 @@
<?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:complexType name="TSampleType1">
<xsd:sequence>
<xsd:choice>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:choice>
<xsd:element name="intField1" type="xsd:int" />
<xsd:element name="dateField" type="xsd:date" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

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

@@ -28,6 +28,9 @@ type
{ TTest_CustomXsdParser } { TTest_CustomXsdParser }
TTest_CustomXsdParser = class(TTestCase) TTest_CustomXsdParser = class(TTestCase)
protected
function ParseDoc(const ADoc : string) : TwstPasTreeContainer;overload;virtual;
function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;overload;virtual;abstract;
protected protected
function LoadEmptySchema() : TwstPasTreeContainer;virtual;abstract; function LoadEmptySchema() : TwstPasTreeContainer;virtual;abstract;
function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;virtual;abstract;
@@ -42,6 +45,10 @@ type
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
@@ -69,6 +76,10 @@ type
function load_schema_include_fail_namespace() : TwstPasTreeContainer;virtual;abstract; function load_schema_include_fail_namespace() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_circular1() : TwstPasTreeContainer;virtual;abstract; function load_schema_include_circular1() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_circular2() : TwstPasTreeContainer;virtual;abstract; function load_schema_include_circular2() : TwstPasTreeContainer;virtual;abstract;
function load_schema_case_sensitive() : TwstPasTreeContainer;virtual;abstract;
function load_schema_case_sensitive2() : TwstPasTreeContainer;virtual;abstract;
function load_schema_case_sensitive_import() : TwstPasTreeContainer;virtual;abstract;
published published
procedure EmptySchema(); procedure EmptySchema();
@@ -88,6 +99,10 @@ type
procedure ComplexType_Class_sequence_open_type_anyAttribute(); procedure ComplexType_Class_sequence_open_type_anyAttribute();
procedure ComplexType_Class_all_open_type_anyAttribute(); procedure ComplexType_Class_all_open_type_anyAttribute();
procedure ComplexType_Class_FalseArray(); procedure ComplexType_Class_FalseArray();
procedure ComplexType_Class_Choice();
procedure ComplexType_Class_Choice2();
procedure ComplexType_Class_Choice3();
procedure ComplexType_Class_Choice4();
procedure ComplexType_Record(); procedure ComplexType_Record();
procedure ComplexType_Record_Embedded(); procedure ComplexType_Record_Embedded();
@@ -113,13 +128,17 @@ type
procedure schema_include_fail_namespace(); procedure schema_include_fail_namespace();
procedure schema_include_circular1(); procedure schema_include_circular1();
procedure schema_include_circular2(); procedure schema_include_circular2();
procedure case_sensitive();
procedure case_sensitive2();
procedure case_sensitive_import();
end; end;
{ TTest_XsdParser } { TTest_XsdParser }
TTest_XsdParser = class(TTest_CustomXsdParser) TTest_XsdParser = class(TTest_CustomXsdParser)
private protected
function ParseDoc(const ADoc : string) : TwstPasTreeContainer; function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;override;
protected protected
function LoadEmptySchema() : TwstPasTreeContainer;override; function LoadEmptySchema() : TwstPasTreeContainer;override;
@@ -135,6 +154,10 @@ type
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
@@ -162,13 +185,17 @@ type
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override; function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
function load_schema_include_circular1() : TwstPasTreeContainer;override; function load_schema_include_circular1() : TwstPasTreeContainer;override;
function load_schema_include_circular2() : TwstPasTreeContainer;override; function load_schema_include_circular2() : TwstPasTreeContainer;override;
function load_schema_case_sensitive() : TwstPasTreeContainer;override;
function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
end; end;
{ TTest_WsdlParser } { TTest_WsdlParser }
TTest_WsdlParser = class(TTest_CustomXsdParser) TTest_WsdlParser = class(TTest_CustomXsdParser)
private private
function ParseDoc(const ADoc : string) : TwstPasTreeContainer; function ParseDoc(const ADoc : string; const ACaseSensitive : Boolean) : TwstPasTreeContainer;override;
protected protected
function LoadEmptySchema() : TwstPasTreeContainer;override; function LoadEmptySchema() : TwstPasTreeContainer;override;
@@ -184,6 +211,10 @@ type
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
@@ -210,7 +241,11 @@ type
function load_schema_include_parent_no_types() : TwstPasTreeContainer;override; function load_schema_include_parent_no_types() : TwstPasTreeContainer;override;
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override; function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
function load_schema_include_circular1() : TwstPasTreeContainer;override; function load_schema_include_circular1() : TwstPasTreeContainer;override;
function load_schema_include_circular2() : TwstPasTreeContainer;override; function load_schema_include_circular2() : TwstPasTreeContainer;override;
function load_schema_case_sensitive() : TwstPasTreeContainer;override;
function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
published published
procedure no_binding_style(); procedure no_binding_style();
procedure signature_last(); procedure signature_last();
@@ -299,6 +334,11 @@ end;
{ TTest_CustomXsdParser } { TTest_CustomXsdParser }
function TTest_CustomXsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer;
begin
Result := ParseDoc(ADoc,False);
end;
procedure TTest_CustomXsdParser.EmptySchema(); procedure TTest_CustomXsdParser.EmptySchema();
var var
tr : TwstPasTreeContainer; tr : TwstPasTreeContainer;
@@ -995,6 +1035,240 @@ begin
end; end;
end; end;
procedure TTest_CustomXsdParser.ComplexType_Class_Choice();
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := LoadComplexType_Class_Choice_Schema();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('complex_class_choice',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(1,ls.Count);
elt := tr.FindElement('TSampleType1');
CheckNotNull(elt,'TSampleType1');
CheckEquals('TSampleType1',elt.Name);
CheckEquals('TSampleType1',tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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,prpLs.Count);
CheckProperty(x_intField,'int',ptField);
CheckProperty(x_strField,'string',ptField);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_Choice2();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
procedure CheckProperty(const AName,ATypeName : string);
var
prp : TPasProperty;
prpType : 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);
prpType := TPasArrayType(prp.VarType);
CheckNotNull(prpType.ElType);
CheckEquals(ATypeName,tr.GetExternalName(prpType.ElType));
end;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := LoadComplexType_Class_Choice2_Schema();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('complex_class_choice2',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
elt := tr.FindElement('TSampleType1');
CheckNotNull(elt,'TSampleType1');
CheckEquals('TSampleType1',elt.Name);
CheckEquals('TSampleType1',tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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,prpLs.Count);
CheckProperty(x_intField,'int');
CheckProperty(x_strField,'string');
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_Choice3();
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := LoadComplexType_Class_Choice3_Schema();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('complex_class_choice3',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(1,ls.Count);
elt := tr.FindElement('TSampleType1');
CheckNotNull(elt,'TSampleType1');
CheckEquals('TSampleType1',elt.Name);
CheckEquals('TSampleType1',tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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(4,prpLs.Count);
CheckProperty('intField1','int',ptField);
CheckProperty(x_intField,'int',ptField);
CheckProperty(x_strField,'string',ptField);
CheckProperty('dateField','date',ptField);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_Choice4();
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := LoadComplexType_Class_Choice4_Schema();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('complex_class_choice4',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(1,ls.Count);
elt := tr.FindElement('TSampleType1');
CheckNotNull(elt,'TSampleType1');
CheckEquals('TSampleType1',elt.Name);
CheckEquals('TSampleType1',tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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(4,prpLs.Count);
CheckProperty('intField1','int',ptField);
CheckProperty(x_intField,'int',ptField);
CheckProperty(x_strField,'string',ptField);
CheckProperty('dateField','date',ptField);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Record(); procedure TTest_CustomXsdParser.ComplexType_Record();
var var
tr : TwstPasTreeContainer; tr : TwstPasTreeContainer;
@@ -2164,9 +2438,278 @@ begin
end; end;
end; end;
procedure TTest_CustomXsdParser.case_sensitive();
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := load_schema_case_sensitive();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('case_sensitive',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(4,ls.Count);
elt := tr.FindElement('Date');
CheckNotNull(elt,'Date');
CheckEquals('Date',tr.GetExternalName(elt));
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'Date.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('String');
CheckNotNull(elt,'String');
CheckEquals('String',tr.GetExternalName(elt));
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'String.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('Boolean');
CheckNotNull(elt,'Boolean');
CheckEquals('Boolean',tr.GetExternalName(elt));
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'Boolean.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement(x_complexType_SampleClassType);
CheckNotNull(elt,x_complexType_SampleClassType);
CheckEquals(x_complexType_SampleClassType,elt.Name);
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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(8,prpLs.Count);
CheckProperty('dateField','date',ptField);
CheckProperty('localDateField','Date',ptField);
CheckProperty('booleanField','boolean',ptField);
CheckProperty('localBooleanField','Boolean',ptField);
CheckProperty('stringField','string',ptField);
CheckProperty('localStringField','String',ptField);
CheckProperty('dateAtt','date',ptAttribute);
CheckProperty('localDateAtt','Date',ptAttribute);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.case_sensitive2();
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := load_schema_case_sensitive2();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
CheckEquals('case_sensitive2',mdl.Name);
CheckEquals(x_targetNamespace,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(3,ls.Count);
elt := tr.FindElement('SampleType');
CheckNotNull(elt,'SampleType');
CheckEquals('SampleType',tr.GetExternalName(elt));
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('SAMPLETYPE');
CheckNotNull(elt,'SAMPLETYPE');
CheckEquals('SAMPLETYPE',tr.GetExternalName(elt));
CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement(x_complexType_SampleClassType);
CheckNotNull(elt,x_complexType_SampleClassType);
CheckEquals(x_complexType_SampleClassType,elt.Name);
CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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,prpLs.Count);
CheckProperty('Field1','SampleType',ptField);
CheckProperty('Field2','SAMPLETYPE',ptField);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.case_sensitive_import();
const CONST_NS = 'urn:wst-test3';
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;
var
mdl : TPasModule;
ls : TList;
elt : TPasElement;
aliasType : TPasAliasType;
i : Integer;
prpLs : TList;
begin
tr := nil;
prpLs := TList.Create();
try
tr := load_schema_case_sensitive_import();
//-----------------------------------------
mdl := tr.FindModule('urn:wst-test');
CheckNotNull(mdl);
CheckEquals('case_sensitive2',mdl.Name);
CheckEquals('urn:wst-test',tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(3,ls.Count);
elt := tr.FindElement('SampleType');
CheckNotNull(elt,'SampleType');
CheckEquals('SampleType',tr.GetExternalName(elt));
CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('SAMPLETYPE');
CheckNotNull(elt,'SAMPLETYPE');
CheckEquals('SAMPLETYPE',tr.GetExternalName(elt));
CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
//-----------------------------------------
mdl := tr.FindModule(CONST_NS);
CheckNotNull(mdl);
CheckEquals('case_sensitive3',mdl.Name);
CheckEquals(CONST_NS,tr.GetExternalName(mdl));
ls := mdl.InterfaceSection.Declarations;
CheckEquals(3,ls.Count);
elt := tr.FindElement('TypeA');
CheckNotNull(elt,'TypeA');
CheckEquals('TypeA',tr.GetExternalName(elt));
CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'TypeA.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('TYPEA');
CheckNotNull(elt,'TYPEA');
CheckEquals('TYPEA',tr.GetExternalName(elt));
CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType));
CheckIs(elt,TPasAliasType);
CheckNotNull(TPasAliasType(elt).DestType,'TYPEA.DestType');
CheckEquals('string',TPasAliasType(elt).DestType.Name);
elt := tr.FindElement('CompoundType');
CheckNotNull(elt,'CompoundType');
CheckEquals('CompoundType',elt.Name);
CheckEquals('CompoundType',tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
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(4,prpLs.Count);
CheckProperty('f1','SampleType',ptField);
CheckProperty('f2','SAMPLETYPE',ptField);
CheckProperty('f3','TypeA',ptField);
CheckProperty('f4','TYPEA',ptField);
finally
FreeAndNil(prpLs);
FreeAndNil(tr);
end;
end;
{ TTest_XsdParser } { TTest_XsdParser }
function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; function TTest_XsdParser.ParseDoc(
const ADoc: string;
const ACaseSensistive: Boolean
): TwstPasTreeContainer;
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prs : IXsdPaser; prs : IXsdPaser;
@@ -2177,6 +2720,7 @@ begin
locDoc := LoadXmlFile(fileName); locDoc := LoadXmlFile(fileName);
try try
Result := TwstPasTreeContainer.Create(); Result := TwstPasTreeContainer.Create();
Result.CaseSensitive := ACaseSensistive;
CreateWstInterfaceSymbolTable(Result); CreateWstInterfaceSymbolTable(Result);
prs := TXsdParser.Create(locDoc,Result,ADoc); prs := TXsdParser.Create(locDoc,Result,ADoc);
prsCtx := prs as IParserContext; prsCtx := prs as IParserContext;
@@ -2337,6 +2881,21 @@ begin
Result := ParseDoc('include_circular2'); Result := ParseDoc('include_circular2');
end; end;
function TTest_XsdParser.load_schema_case_sensitive(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive',True);
end;
function TTest_XsdParser.load_schema_case_sensitive2(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive2',True);
end;
function TTest_XsdParser.load_schema_case_sensitive_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive3',True);
end;
function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer; function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer;
begin begin
Result := ParseDoc('class_widechar_property'); Result := ParseDoc('class_widechar_property');
@@ -2352,9 +2911,32 @@ begin
Result := ParseDoc('complex_class_false_array'); Result := ParseDoc('complex_class_false_array');
end; end;
function TTest_XsdParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice');
end;
function TTest_XsdParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice2');
end;
function TTest_XsdParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice3');
end;
function TTest_XsdParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice4');
end;
{ TTest_WsdlParser } { TTest_WsdlParser }
function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; function TTest_WsdlParser.ParseDoc(
const ADoc: string;
const ACaseSensitive: Boolean
) : TwstPasTreeContainer;
var var
locDoc : TXMLDocument; locDoc : TXMLDocument;
prs : IParser; prs : IParser;
@@ -2365,6 +2947,7 @@ begin
locDoc := LoadXmlFile(fileName); locDoc := LoadXmlFile(fileName);
try try
Result := TwstPasTreeContainer.Create(); Result := TwstPasTreeContainer.Create();
Result.CaseSensitive := ACaseSensitive;
CreateWstInterfaceSymbolTable(Result); CreateWstInterfaceSymbolTable(Result);
prs := TWsdlParser.Create(locDoc,Result); prs := TWsdlParser.Create(locDoc,Result);
prsCtx := prs as IParserContext; prsCtx := prs as IParserContext;
@@ -2420,6 +3003,26 @@ begin
Result := ParseDoc('complex_class_false_array'); Result := ParseDoc('complex_class_false_array');
end; end;
function TTest_WsdlParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice');
end;
function TTest_WsdlParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice2');
end;
function TTest_WsdlParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice3');
end;
function TTest_WsdlParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_choice4');
end;
function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer; function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer;
begin begin
Result := ParseDoc(x_complexType_record); Result := ParseDoc(x_complexType_record);
@@ -3104,6 +3707,21 @@ begin
Result := ParseDoc('include_circular2'); Result := ParseDoc('include_circular2');
end; end;
function TTest_WsdlParser.load_schema_case_sensitive(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive',True);
end;
function TTest_WsdlParser.load_schema_case_sensitive2(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive2',True);
end;
function TTest_WsdlParser.load_schema_case_sensitive_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('case_sensitive3',True);
end;
initialization initialization
RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('XSD parser',TTest_XsdParser.Suite);
RegisterTest('WSDL parser',TTest_WsdlParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite);

6
wst/trunk/tests/test_suite/testmetadata_unit.pas
View File

@@ -99,7 +99,7 @@ begin
sct.Declarations.Add(inft); sct.Declarations.Add(inft);
sct.Types.Add(inft); sct.Types.Add(inft);
CreateProc('void_operation_proc',inft,Result); CreateProc('void_operation_proc',inft,Result);
CreateFunc('void_operation_func','Integer',inft,Result); CreateFunc('void_operation_func','integer',inft,Result);
inft := TPasClassType(Result.CreateElement(TPasClassType,'service_2',sct,visDefault,'',0)); inft := TPasClassType(Result.CreateElement(TPasClassType,'service_2',sct,visDefault,'',0));
inft.ObjKind := okInterface; inft.ObjKind := okInterface;
@@ -107,11 +107,11 @@ begin
sct.Types.Add(inft); sct.Types.Add(inft);
locProc := CreateProc('dis_proc',inft,Result); locProc := CreateProc('dis_proc',inft,Result);
CreateParam('d','double',argDefault,locProc,Result); CreateParam('d','double',argDefault,locProc,Result);
CreateParam('i','Integer',argConst,locProc,Result); CreateParam('i','integer',argConst,locProc,Result);
CreateParam('s','string',argOut,locProc,Result); CreateParam('s','string',argOut,locProc,Result);
locProc := CreateFunc('sid_func','double',inft,Result); locProc := CreateFunc('sid_func','double',inft,Result);
CreateParam('s','string',argConst,locProc,Result); CreateParam('s','string',argConst,locProc,Result);
CreateParam('i','Integer',argVar,locProc,Result); CreateParam('i','integer',argVar,locProc,Result);
end; end;
procedure PrintWSDL(ARep : PServiceRepository); procedure PrintWSDL(ARep : PServiceRepository);

2
wst/trunk/ws_helper/parserutils.pas
View File

@@ -89,7 +89,7 @@ type
function AddNameSpace(const AValue: string; ANameSpaceList : TStrings): TStrings; function AddNameSpace(const AValue: string; ANameSpaceList : TStrings): TStrings;
procedure BuildNameSpaceList(AAttCursor : IObjectCursor; ANameSpaceList : TStrings); procedure BuildNameSpaceList(AAttCursor : IObjectCursor; ANameSpaceList : TStrings);
procedure ExplodeQName(const AQName : string; out ALocalName, ANameSpace : string) ; procedure ExplodeQName(const AQName : string; out ALocalName, ANameSpace : string) ;
function wst_findCustomAttribute( function wst_findCustomAttribute(
AWsdlShortNames : TStrings; AWsdlShortNames : TStrings;
ANode : TDOMNode; ANode : TDOMNode;

5
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@@ -33,6 +33,8 @@ const
sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; sXSD_NS = 'http://www.w3.org/2001/XMLSchema';
CASE_SENSITIVE_DEFAULT = True;
{$IF not Declared(TInterfaceSection) } {$IF not Declared(TInterfaceSection) }
type type
TInterfaceSection = TPasSection; TInterfaceSection = TPasSection;
@@ -165,7 +167,7 @@ type
function IsInitNeed(AType: TPasType): Boolean; function IsInitNeed(AType: TPasType): Boolean;
function IsOfType(AType: TPasType; AClass: TClass): Boolean; function IsOfType(AType: TPasType; AClass: TClass): Boolean;
property CaseSensitive : Boolean read FCaseSensitive write FCaseSensitive; property CaseSensitive : Boolean read FCaseSensitive write FCaseSensitive default CASE_SENSITIVE_DEFAULT;
end; end;
TPasNativeModule = class(TPasModule) TPasNativeModule = class(TPasModule)
@@ -632,6 +634,7 @@ end;
constructor TwstPasTreeContainer.Create(); constructor TwstPasTreeContainer.Create();
begin begin
FCaseSensitive := CASE_SENSITIVE_DEFAULT;
FPackage := TPasPackage.Create('sample',nil); FPackage := TPasPackage.Create('sample',nil);
FBindingList := TObjectList.Create(True); FBindingList := TObjectList.Create(True);
FProperties := TPropertyHolder.Create(); FProperties := TPropertyHolder.Create();

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

@@ -124,6 +124,7 @@ type
private private
//helper routines //helper routines
function ExtractElementCursor( function ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor; out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode out AAnyNode, AAnyAttNode : TDOMNode
):IObjectCursor; ):IObjectCursor;
@@ -424,6 +425,7 @@ end;
{ TComplexTypeParser } { TComplexTypeParser }
function TComplexTypeParser.ExtractElementCursor( function TComplexTypeParser.ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor; out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode out AAnyNode, AAnyAttNode : TDOMNode
) : IObjectCursor; ) : IObjectCursor;
@@ -457,11 +459,18 @@ var
var var
tmpCursor : IObjectCursor; tmpCursor : IObjectCursor;
tmpNode : TDOMNode; tmpNode : TDOMNode;
tmpFilter : IObjectFilter;
begin begin
ARes := nil; ARes := nil;
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor, frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer) tmpFilter
); );
tmpCursor.Reset(); tmpCursor.Reset();
Result := tmpCursor.MoveNext(); Result := tmpCursor.MoveNext();
@@ -469,9 +478,15 @@ var
FSequenceType := stElement; FSequenceType := stElement;
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin if tmpNode.HasChildNodes() then begin
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode), CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer) tmpFilter
); );
ARes := tmpCursor; ARes := tmpCursor;
tmpCursor := CreateCursorOn( tmpCursor := CreateCursorOn(
@@ -493,10 +508,13 @@ begin
AAttCursor := nil; AAttCursor := nil;
AAnyNode := nil; AAnyNode := nil;
AAnyAttNode := nil; AAnyAttNode := nil;
case FDerivationMode of parentNode := AParentNode;
dmNone : parentNode := FContentNode; if (parentNode = nil) then begin
dmRestriction, case FDerivationMode of
dmExtension : parentNode := FDerivationNode; dmNone : parentNode := FContentNode;
dmRestriction,
dmExtension : parentNode := FDerivationNode;
end;
end; end;
if parentNode.HasChildNodes() then begin; if parentNode.HasChildNodes() then begin;
AAttCursor := CreateCursorOn( AAttCursor := CreateCursorOn(
@@ -805,6 +823,14 @@ begin
end; end;
end; end;
type
TOccurrenceRec = record
Valid : Boolean;
MinOccurs : Integer;
MaxOccurs : Integer;
Unboundded : Boolean;
end;
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType; function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType;
var var
classDef : TPasClassType; classDef : TPasClassType;
@@ -818,7 +844,58 @@ var
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
procedure ParseElement(AElement : TDOMNode); procedure ExtractOccurences(
AItemName : string;
AAttCursor : IObjectCursor;
var AMinOccurs,
AMaxOccurs : Integer;
var AMaxUnboundded : Boolean
);
var
locAttCursor, 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);
var var
locAttCursor, locPartCursor : IObjectCursor; locAttCursor, locPartCursor : IObjectCursor;
locName, locTypeName, locTypeInternalName : string; locName, locTypeName, locTypeInternalName : string;
@@ -939,14 +1016,18 @@ var
locMinOccur := 0; locMinOccur := 0;
end; end;
end else begin end else begin
locMinOccur := 1; if ABoundInfos.Valid then begin
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); locMinOccur := ABoundInfos.MinOccurs;
locPartCursor.Reset(); end else begin
if locPartCursor.MoveNext() then begin locMinOccur := 1;
if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); locPartCursor.Reset();
if ( locMinOccur < 0 ) then if locPartCursor.MoveNext() then begin
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
end;
end; end;
end; end;
locProp.ReadAccessorName := 'F' + locProp.Name; locProp.ReadAccessorName := 'F' + locProp.Name;
@@ -959,19 +1040,24 @@ var
locProp.StoredAccessorName := 'True'; locProp.StoredAccessorName := 'True';
end; end;
locMaxOccur := 1; if ABoundInfos.Valid then begin
locMaxOccurUnbounded := False; locMaxOccur := ABoundInfos.MaxOccurs;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer)); locMaxOccurUnbounded := ABoundInfos.Unboundded;
locPartCursor.Reset(); end else begin
if locPartCursor.MoveNext() then begin locMaxOccur := 1;
locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; locMaxOccurUnbounded := False;
if AnsiSameText(locStrBuffer,s_unbounded) then begin locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
locMaxOccurUnbounded := True; locPartCursor.Reset();
end else begin if locPartCursor.MoveNext() then begin
if not TryStrToInt(locStrBuffer,locMaxOccur) then locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); if AnsiSameText(locStrBuffer,s_unbounded) then begin
if ( locMinOccur < 0 ) then locMaxOccurUnbounded := True;
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); end else begin
if not TryStrToInt(locStrBuffer,locMaxOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
end;
end; end;
end; end;
isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 ); isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 );
@@ -995,18 +1081,56 @@ var
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer)); Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end; end;
procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor); procedure ParseElementsAndAttributes(
AEltCrs,
AEltAttCrs : IObjectCursor;
ABoundInfos : TOccurrenceRec
);
function ExtractElement(ANode : TDOMNode) : IObjectCursor;
var
tmpFilter : IObjectFilter;
begin
tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer);
tmpFilter := TAggregatedFilter.Create(
tmpFilter,
ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer),
fcOr
) as IObjectFilter;
Result := CreateCursorOn(
CreateChildrenCursor(ANode,cetRttiNode),
tmpFilter
);
end;
var
locNode, locAnyNode, locAnyAttNode : TDOMNode;
locNS, locLN : string;
locEltCrs, locEltAttCrs : IObjectCursor;
locBoundInfos : TOccurrenceRec;
begin begin
if Assigned(AEltCrs) then begin if Assigned(AEltCrs) then begin
AEltCrs.Reset(); AEltCrs.Reset();
while AEltCrs.MoveNext() do begin while AEltCrs.MoveNext() do begin
ParseElement((AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); locNode := (AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
ExplodeQName(locNode.NodeName,locLN,locNS);
if (locLN = s_choice) then begin
locEltCrs := ExtractElement(locNode);
if (locEltCrs <> nil) then begin
ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
ParseElementsAndAttributes(locEltCrs,locEltAttCrs,locBoundInfos);
end;
end else begin
ParseElement(locNode,ABoundInfos);
end;
end; end;
end; end;
if Assigned(AEltAttCrs) then begin if Assigned(AEltAttCrs) then begin
AEltAttCrs.Reset(); AEltAttCrs.Reset();
while AEltAttCrs.MoveNext() do begin while AEltAttCrs.MoveNext() do begin
ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject,ABoundInfos);
end; end;
end; end;
end; end;
@@ -1067,9 +1191,11 @@ var
locStrBuffer : string; locStrBuffer : string;
locAnyNode, locAnyAttNode : TDOMNode; locAnyNode, locAnyAttNode : TDOMNode;
locDefaultAncestorUsed : Boolean; locDefaultAncestorUsed : Boolean;
locBoundInfos : TOccurrenceRec;
locTempNode : TDOMNode;
begin begin
ExtractBaseType(); ExtractBaseType();
eltCrs := ExtractElementCursor(eltAttCrs,locAnyNode,locAnyAttNode); eltCrs := ExtractElementCursor(nil,eltAttCrs,locAnyNode,locAnyAttNode);
internalName := ExtractIdentifier(ATypeName); internalName := ExtractIdentifier(ATypeName);
hasInternalName := IsReservedKeyWord(internalName) or hasInternalName := IsReservedKeyWord(internalName) or
@@ -1110,7 +1236,24 @@ begin
classDef.AncestorType.AddRef(); classDef.AncestorType.AddRef();
if Assigned(eltCrs) or Assigned(eltAttCrs) then begin if Assigned(eltCrs) or Assigned(eltAttCrs) then begin
isArrayDef := False; isArrayDef := False;
ParseElementsAndAttributes(eltCrs,eltAttCrs); FillChar(locBoundInfos,SizeOf(locBoundInfos),#0);
if (eltCrs <> nil) then begin
eltCrs.Reset();
if eltCrs.MoveNext() then begin
locTempNode := (eltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
locTempNode := locTempNode.ParentNode;
if (ExtractNameFromQName(locTempNode.NodeName) = s_choice) then begin
ExtractOccurences(
s_choice,
CreateAttributesCursor(locTempNode,cetRttiNode),
locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded
);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
end;
end;
end;
ParseElementsAndAttributes(eltCrs,eltAttCrs,locBoundInfos);
if ( arrayItems.GetCount() > 0 ) then begin if ( arrayItems.GetCount() > 0 ) then begin
if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and
( GetElementCount(classDef.Members,TPasProperty) = 1 ) ( GetElementCount(classDef.Members,TPasProperty) = 1 )

1
wst/trunk/ws_helper/xsd_consts.pas
View File

@@ -35,6 +35,7 @@ const
s_base : WideString = 'base'; s_base : WideString = 'base';
s_binding : WideString = 'binding'; s_binding : WideString = 'binding';
s_body : WideString = 'body'; s_body : WideString = 'body';
s_choice = 'choice';
s_complexContent : WideString = 'complexContent'; s_complexContent : WideString = 'complexContent';
s_complexType : WideString = 'complexType'; s_complexType : WideString = 'complexType';
s_customAttributes : WideString = 'customAttributes'; s_customAttributes : WideString = 'customAttributes';