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

XSD's "include" handling, better "uses" generation for schema files translalted to pascal, better generated file names, handling of "import" and "include" in sub-directories, Handling of TComplexEnumContentRemotable

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1856 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2011-08-29 02:59:57 +00:00
parent f2ef6e252b
commit ac7aeb38c8
29 changed files with 1022 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
wst/trunk/tests/test_suite/files/include.xsd Normal file
View File

@ -0,0 +1,18 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="includea.xsd" />
<xsd:include schemaLocation="includeb.xsd" />
<xsd:include schemaLocation="includec.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
<xsd:element name="FieldC" type="n:TypeC" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

20
wst/trunk/tests/test_suite/files/include2.wsdl Normal file
View File

@ -0,0 +1,20 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:include-wsdl"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:include-wsdl">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:include">
<xsd:include schemaLocation="includea.xsd" />
<xsd:include schemaLocation="includeb.xsd" />
<xsd:include schemaLocation="includec.xsd" />
</xsd:schema>
</types>
</definitions>

10
wst/trunk/tests/test_suite/files/include2.xsd Normal file
View File

@ -0,0 +1,10 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="includea.xsd" />
<xsd:include schemaLocation="includeb.xsd" />
<xsd:include schemaLocation="includec.xsd" />
</xsd:schema>

8
wst/trunk/tests/test_suite/files/include3.xsd Normal file
View File

@ -0,0 +1,8 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_no_ns.xsd" />
</xsd:schema>

15
wst/trunk/tests/test_suite/files/include_a_b.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_b_a.xsd" />
<xsd:simpleType name="TypeA">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="taOne"> </xsd:enumeration>
<xsd:enumeration value="taTwo"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

15
wst/trunk/tests/test_suite/files/include_b_a.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_a_b.xsd" />
<xsd:simpleType name="TypeB">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tbThree"> </xsd:enumeration>
<xsd:enumeration value="tbFour"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

15
wst/trunk/tests/test_suite/files/include_cir1.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_cir2.xsd" />
<xsd:simpleType name="TypeA">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="taOne"> </xsd:enumeration>
<xsd:enumeration value="taTwo"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

15
wst/trunk/tests/test_suite/files/include_cir2.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_cir3.xsd" />
<xsd:simpleType name="TypeB">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tbThree"> </xsd:enumeration>
<xsd:enumeration value="tbFour"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

15
wst/trunk/tests/test_suite/files/include_cir3.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_cir1.xsd" />
<xsd:simpleType name="TypeC">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tcFive"> </xsd:enumeration>
<xsd:enumeration value="tcSix"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

25
wst/trunk/tests/test_suite/files/include_circular1.wsdl Normal file
View File

@ -0,0 +1,25 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:include-wsdl"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:include-wsdl">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:n="urn:include" targetNamespace="urn:include">
<xsd:include schemaLocation="include_a_b.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

15
wst/trunk/tests/test_suite/files/include_circular1.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_a_b.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

26
wst/trunk/tests/test_suite/files/include_circular2.wsdl Normal file
View File

@ -0,0 +1,26 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:include-wsdl"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:include-wsdl">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:n="urn:include" targetNamespace="urn:include">
<xsd:include schemaLocation="include_cir1.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

15
wst/trunk/tests/test_suite/files/include_circular2.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="include_cir1.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

18
wst/trunk/tests/test_suite/files/include_error.wsdl Normal file
View File

@ -0,0 +1,18 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:include-wsdl"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:include-wsdl">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:n="urn:include" targetNamespace="urn:include">
<xsd:include schemaLocation="includens.xsd" />
</xsd:schema>
</types>
</definitions>

8
wst/trunk/tests/test_suite/files/include_error.xsd Normal file
View File

@ -0,0 +1,8 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:include schemaLocation="includens.xsd" />
</xsd:schema>

11
wst/trunk/tests/test_suite/files/include_no_ns.xsd Normal file
View File

@ -0,0 +1,11 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema" >
<xsd:simpleType name="TypeNoS">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tnosFive"> </xsd:enumeration>
<xsd:enumeration value="tnosSix"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

28
wst/trunk/tests/test_suite/files/include_schema.wsdl Normal file
View File

@ -0,0 +1,28 @@
<?xml version="1.0"?>
<definitions name="import_second_library"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="urn:include-wsdl"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:include-wsdl">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:n="urn:include" targetNamespace="urn:include">
<xsd:include schemaLocation="includea.xsd" />
<xsd:include schemaLocation="includeb.xsd" />
<xsd:include schemaLocation="includec.xsd" />
<xsd:complexType name="TClassSample">
<xsd:sequence>
<xsd:element name="FieldA" type="n:TypeA" />
<xsd:element name="FieldB" type="n:TypeB" />
<xsd:element name="FieldC" type="n:TypeC" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

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

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:simpleType name="TypeA">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="taOne"> </xsd:enumeration>
<xsd:enumeration value="taTwo"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

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

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:simpleType name="TypeB">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tbThree"> </xsd:enumeration>
<xsd:enumeration value="tbFour"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

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

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include">
<xsd:simpleType name="TypeC">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tcFive"> </xsd:enumeration>
<xsd:enumeration value="tcSix"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

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

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:include-ns"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:include-ns">
<xsd:simpleType name="TypeNS">
<xsd:restriction base="xsd:token">
<xsd:enumeration value="tnsFive"> </xsd:enumeration>
<xsd:enumeration value="tnsSix"> </xsd:enumeration>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>

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

@ -64,6 +64,11 @@ type
function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract; function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract;
function load_schema_import() : TwstPasTreeContainer;virtual;abstract; function load_schema_import() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_parent_no_types() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_fail_namespace() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_circular1() : TwstPasTreeContainer;virtual;abstract;
function load_schema_include_circular2() : TwstPasTreeContainer;virtual;abstract;
published published
procedure EmptySchema(); procedure EmptySchema();
@ -102,8 +107,12 @@ type
procedure class_widechar_property(); procedure class_widechar_property();
procedure class_currency_property(); procedure class_currency_property();
procedure class_property_composed_name(); procedure class_property_composed_name();
procedure schema_import(); procedure schema_import();
procedure schema_include();
procedure schema_include_parent_no_types();
procedure schema_include_fail_namespace();
procedure schema_include_circular1();
procedure schema_include_circular2();
end; end;
{ TTest_XsdParser } { TTest_XsdParser }
@ -148,6 +157,11 @@ type
function load_class_property_composed_name() : TwstPasTreeContainer;override; function load_class_property_composed_name() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override; function load_schema_import() : TwstPasTreeContainer;override;
function load_schema_include() : TwstPasTreeContainer;override;
function load_schema_include_parent_no_types() : TwstPasTreeContainer;override;
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
function load_schema_include_circular1() : TwstPasTreeContainer;override;
function load_schema_include_circular2() : TwstPasTreeContainer;override;
end; end;
{ TTest_WsdlParser } { TTest_WsdlParser }
@ -192,6 +206,11 @@ type
function load_class_property_composed_name() : TwstPasTreeContainer;override; function load_class_property_composed_name() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override; function load_schema_import() : TwstPasTreeContainer;override;
function load_schema_include() : TwstPasTreeContainer;override;
function load_schema_include_parent_no_types() : TwstPasTreeContainer;override;
function load_schema_include_fail_namespace() : TwstPasTreeContainer;override;
function load_schema_include_circular1() : TwstPasTreeContainer;override;
function load_schema_include_circular2() : TwstPasTreeContainer;override;
published published
procedure no_binding_style(); procedure no_binding_style();
procedure signature_last(); procedure signature_last();
@ -2005,6 +2024,146 @@ begin
FreeAndNil(tr); FreeAndNil(tr);
end; end;
procedure TTest_CustomXsdParser.schema_include();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
ls : TList;
elt, prpElt : TPasElement;
prp : TPasProperty;
baseType, scdClass : TPasClassType;
begin
tr := load_schema_include();
try
mdl := tr.FindModule('urn:include');
CheckNotNull(mdl);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(4,ls.Count,'type count');
elt := tr.FindElement('TypeA');
CheckNotNull(elt,'TypeA');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeB');
CheckNotNull(elt,'TypeB');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeC');
CheckNotNull(elt,'TypeC');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TClassSample');
CheckNotNull(elt,'TClassSample');
CheckIs(elt,TPasClassType);
finally
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.schema_include_parent_no_types();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
ls : TList;
elt, prpElt : TPasElement;
prp : TPasProperty;
baseType, scdClass : TPasClassType;
begin
tr := load_schema_include_parent_no_types();
try
mdl := tr.FindModule('urn:include');
CheckNotNull(mdl);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(3,ls.Count,'type count');
elt := tr.FindElement('TypeA');
CheckNotNull(elt,'TypeA');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeB');
CheckNotNull(elt,'TypeB');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeC');
CheckNotNull(elt,'TypeC');
CheckIs(elt,TPasEnumType);
finally
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.schema_include_fail_namespace();
var
tr : TwstPasTreeContainer;
ok : Boolean;
begin
tr := nil;
ok := False;
try
tr := load_schema_include_fail_namespace();
ok := True;
except
on e : EXsdParserAssertException do
ok := True;
end;
FreeAndNil(tr);
Check(ok);
end;
procedure TTest_CustomXsdParser.schema_include_circular1();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
ls : TList;
elt, prpElt : TPasElement;
prp : TPasProperty;
baseType, scdClass : TPasClassType;
begin
tr := load_schema_include_circular1();
try
mdl := tr.FindModule('urn:include');
CheckNotNull(mdl);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(3,ls.Count,'type count');
elt := tr.FindElement('TypeA');
CheckNotNull(elt,'TypeA');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeB');
CheckNotNull(elt,'TypeB');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TClassSample');
CheckNotNull(elt,'TClassSample');
CheckIs(elt,TPasClassType);
finally
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdParser.schema_include_circular2();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
ls : TList;
elt, prpElt : TPasElement;
prp : TPasProperty;
baseType, scdClass : TPasClassType;
begin
tr := load_schema_include_circular2();
try
mdl := tr.FindModule('urn:include');
CheckNotNull(mdl);
ls := mdl.InterfaceSection.Declarations;
CheckEquals(4,ls.Count,'type count');
elt := tr.FindElement('TypeA');
CheckNotNull(elt,'TypeA');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeB');
CheckNotNull(elt,'TypeB');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TypeC');
CheckNotNull(elt,'TypeC');
CheckIs(elt,TPasEnumType);
elt := tr.FindElement('TClassSample');
CheckNotNull(elt,'TClassSample');
CheckIs(elt,TPasClassType);
finally
FreeAndNil(tr);
end;
end;
{ TTest_XsdParser } { TTest_XsdParser }
function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer;
@ -2153,6 +2312,31 @@ begin
Result := ParseDoc('import_second_library'); Result := ParseDoc('import_second_library');
end; end;
function TTest_XsdParser.load_schema_include() : TwstPasTreeContainer;
begin
Result := ParseDoc('include');
end;
function TTest_XsdParser.load_schema_include_parent_no_types() : TwstPasTreeContainer;
begin
Result := ParseDoc('include2');
end;
function TTest_XsdParser.load_schema_include_fail_namespace() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_error');
end;
function TTest_XsdParser.load_schema_include_circular1() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_circular1');
end;
function TTest_XsdParser.load_schema_include_circular2() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_circular2');
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');
@ -2895,6 +3079,31 @@ begin
Result := ParseDoc('import_second_library'); Result := ParseDoc('import_second_library');
end; end;
function TTest_WsdlParser.load_schema_include() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_schema');
end;
function TTest_WsdlParser.load_schema_include_parent_no_types() : TwstPasTreeContainer;
begin
Result := ParseDoc('include2');
end;
function TTest_WsdlParser.load_schema_include_fail_namespace() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_error');
end;
function TTest_WsdlParser.load_schema_include_circular1() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_circular1');
end;
function TTest_WsdlParser.load_schema_include_circular2() : TwstPasTreeContainer;
begin
Result := ParseDoc('include_circular2');
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);

91
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -231,6 +231,25 @@ type
property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple;
end; end;
{ T_ComplexTestEnumContent }
T_ComplexTestEnumContent = class(TComplexEnumContentRemotable)
private
FBoolSimpleAtt_Exemple: Boolean;
FIntSimpleAtt_Exemple: Integer;
FStrSimpleAtt_Exemple: string;
FValue : TTestEnum;
protected
class function GetEnumTypeInfo() : PTypeInfo;override;
function GetValueAddress() : Pointer;override;
public
property Value : TTestEnum read FValue write FValue;
published
property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple;
property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple;
property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple;
end;
T_ComplexFloatExtendedContent = class(TComplexFloatExtendedContentRemotable) T_ComplexFloatExtendedContent = class(TComplexFloatExtendedContentRemotable)
private private
FBoolSimpleAtt_Exemple: Boolean; FBoolSimpleAtt_Exemple: Boolean;
@ -294,6 +313,7 @@ type
private private
FElt_Exemple: string; FElt_Exemple: string;
FVal_CplxDouble: T_ComplexFloatDoubleContent; FVal_CplxDouble: T_ComplexFloatDoubleContent;
FVal_CplxEnum : T_ComplexTestEnumContent;
FVal_CplxInt16S: T_ComplexInt16SContent; FVal_CplxInt16S: T_ComplexInt16SContent;
FVal_CplxInt16U: T_ComplexInt16UContent; FVal_CplxInt16U: T_ComplexInt16UContent;
FVal_CplxInt32S: T_ComplexInt32SContent; FVal_CplxInt32S: T_ComplexInt32SContent;
@ -324,6 +344,8 @@ type
property Val_CplxInt8U : T_ComplexInt8UContent read FVal_CplxInt8U write FVal_CplxInt8U; property Val_CplxInt8U : T_ComplexInt8UContent read FVal_CplxInt8U write FVal_CplxInt8U;
property Val_CplxInt8S : T_ComplexInt8SContent read FVal_CplxInt8S write FVal_CplxInt8S; property Val_CplxInt8S : T_ComplexInt8SContent read FVal_CplxInt8S write FVal_CplxInt8S;
property Val_CplxEnum : T_ComplexTestEnumContent read FVal_CplxEnum write FVal_CplxEnum;
property Val_CplxExtended : T_ComplexFloatExtendedContent read FVal_CplxExtended write FVal_CplxExtended; property Val_CplxExtended : T_ComplexFloatExtendedContent read FVal_CplxExtended write FVal_CplxExtended;
property Val_CplxDouble : T_ComplexFloatDoubleContent read FVal_CplxDouble write FVal_CplxDouble; property Val_CplxDouble : T_ComplexFloatDoubleContent read FVal_CplxDouble write FVal_CplxDouble;
property Val_CplxString : T_ComplexStringContent read FVal_CplxString write FVal_CplxString; property Val_CplxString : T_ComplexStringContent read FVal_CplxString write FVal_CplxString;
@ -492,6 +514,8 @@ type
procedure Test_CplxInt16SimpleContent_WithClass; procedure Test_CplxInt16SimpleContent_WithClass;
procedure Test_CplxInt8SimpleContent_WithClass; procedure Test_CplxInt8SimpleContent_WithClass;
procedure Test_CplxEnumSimpleContent_WithClass;
procedure Test_CplxFloatExtendedSimpleContent_WithClass; procedure Test_CplxFloatExtendedSimpleContent_WithClass;
procedure Test_CplxStringSimpleContent_WithClass; procedure Test_CplxStringSimpleContent_WithClass;
procedure Test_CplxWideStringSimpleContent_WithClass; procedure Test_CplxWideStringSimpleContent_WithClass;
@ -808,6 +832,18 @@ begin
end; end;
end; end;
{ T_ComplexTestEnumContent }
class function T_ComplexTestEnumContent.GetEnumTypeInfo() : PTypeInfo;
begin
Result := TypeInfo(TTestEnum);
end;
function T_ComplexTestEnumContent.GetValueAddress() : Pointer;
begin
Result := @FValue;
end;
function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean; function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean;
begin begin
Result := True; Result := True;
@ -2680,6 +2716,59 @@ begin
end; end;
end; end;
procedure TTestFormatter.Test_CplxEnumSimpleContent_WithClass;
const VAL_S = teTwo; VAL_U = teThree;
var
f : IFormatterBase;
s : TMemoryStream;
a : TClass_CplxSimpleContent;
ns : T_ComplexTestEnumContent;
x : string;
begin
if not Support_ComplextType_with_SimpleContent() then
Exit;
s := nil;
ns := T_ComplexTestEnumContent.Create();
a := TClass_CplxSimpleContent.Create();
try
a.Val_CplxEnum := T_ComplexTestEnumContent.Create();
a.Val_CplxEnum.Value := VAL_S;
ns.Value := VAL_U;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a);
f.Put('ns',TypeInfo(T_ComplexTestEnumContent),ns);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
FreeAndNil(a);
ns.Value := teOne;
a := TClass_CplxSimpleContent.Create();
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'o1';
f.Get(TypeInfo(TClass_CplxSimpleContent),x,a);
x := 'ns';
f.Get(TypeInfo(TComplexInt8SContentRemotable),x,ns);
f.EndScopeRead();
CheckEquals(Ord(VAL_S),Ord(a.Val_CplxEnum.Value),'a.Val_CplxEnum.Value');
CheckEquals(Ord(VAL_U),Ord(ns.Value),'ns.Value');
finally
FreeAndNil(ns);
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_CplxFloatExtendedSimpleContent_WithClass; procedure TTestFormatter.Test_CplxFloatExtendedSimpleContent_WithClass;
const VAL_S : Extended = -12.10; VAL_U : Double = 10.76; const VAL_S : Extended = -12.10; VAL_U : Double = 10.76;
var var
@ -5681,6 +5770,7 @@ end;
procedure TClass_CplxSimpleContent.FreeObjectProperties(); procedure TClass_CplxSimpleContent.FreeObjectProperties();
begin begin
FreeAndNil(FVal_CplxEnum);
FreeAndNil(FVal_CplxInt64S); FreeAndNil(FVal_CplxInt64S);
FreeAndNil(FVal_CplxInt64U); FreeAndNil(FVal_CplxInt64U);
FreeAndNil(FVal_CplxInt32U); FreeAndNil(FVal_CplxInt32U);
@ -6486,6 +6576,7 @@ initialization
GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8SContent),'T_ComplexInt8SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8SContent),'T_ComplexInt8SContent');
GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8UContent),'T_ComplexInt8UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8UContent),'T_ComplexInt8UContent');
GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexTestEnumContent),'T_ComplexTestEnumContent');
GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent');
GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent');

63
wst/trunk/ws_helper/generator.pas
View File

@ -1115,7 +1115,7 @@ begin
Delete(Result,1,1); Delete(Result,1,1);
end; end;
function TBaseGenerator.GenerateExtraUses() : string; {function TBaseGenerator.GenerateExtraUses() : string;
var var
m : TPasModule; m : TPasModule;
k, currentModuleIndex : Integer; k, currentModuleIndex : Integer;
@ -1134,6 +1134,23 @@ begin
end; end;
if ( Length(Result) > 0 ) then if ( Length(Result) > 0 ) then
Delete(Result,1,2); Delete(Result,1,2);
end;}
function TBaseGenerator.GenerateExtraUses() : string;
var
locUsesList : TList;
locModule : TPasElement;
i : Integer;
begin
Result := '';
locUsesList := SymbolTable.CurrentModule.InterfaceSection.UsesList;
if (locUsesList.Count > 0) then begin
for i := 0 to Pred(locUsesList.Count) do begin
locModule := TPasElement(locUsesList[i]);
Result := Result + ', ' + locModule.Name;
end;
if ( Length(Result) > 0 ) then
Delete(Result,1,2);
end;
end; end;
constructor TBaseGenerator.Create(ASymTable: TwstPasTreeContainer; ASrcMngr: ISourceManager); constructor TBaseGenerator.Create(ASymTable: TwstPasTreeContainer; ASrcMngr: ISourceManager);
@ -2339,6 +2356,7 @@ procedure TInftGenerator.GenerateClass(ASymbol: TPasClassType);
var var
locClassPropNbr, locOptionalPropsNbr, locArrayPropsNbr, locPropCount : Integer; locClassPropNbr, locOptionalPropsNbr, locArrayPropsNbr, locPropCount : Integer;
locPropList : TObjectList; locPropList : TObjectList;
locParentIsEnum : Boolean;
procedure Prepare(); procedure Prepare();
var var
@ -2393,6 +2411,10 @@ var
then begin then begin
trueAncestor := TPasNativeSimpleType(trueAncestor).ExtendableType; trueAncestor := TPasNativeSimpleType(trueAncestor).ExtendableType;
end; end;
locParentIsEnum := trueAncestor.InheritsFrom(TPasEnumType);
if locParentIsEnum then
s := 'TComplexEnumContentRemotable'
else
s := Format('%s',[trueAncestor.Name]); s := Format('%s',[trueAncestor.Name]);
end; end;
end; end;
@ -2458,6 +2480,10 @@ var
end;} end;}
WritePropertyField(p); WritePropertyField(p);
end; end;
if locParentIsEnum then begin
Indent();
WriteLn('FValue : %s;',[ASymbol.AncestorType.Name]);
end;
DecIndent(); DecIndent();
// //
if ( locOptionalPropsNbr > 0 ) then begin if ( locOptionalPropsNbr > 0 ) then begin
@ -2474,7 +2500,16 @@ var
DecIndent(); DecIndent();
end; end;
// //
if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin if locParentIsEnum then begin
Indent();
WriteLn('protected');
IncIndent();
Indent(); WriteLn('class function GetEnumTypeInfo() : PTypeInfo;override;');
Indent(); WriteLn('function GetValueAddress() : Pointer;override;');
DecIndent();
end;
//
if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) or locParentIsEnum then begin
Indent(); Indent();
WriteLn('public'); WriteLn('public');
end; end;
@ -2484,6 +2519,12 @@ var
Indent(); WriteLn('procedure FreeObjectProperties();override;'); Indent(); WriteLn('procedure FreeObjectProperties();override;');
DecIndent(); DecIndent();
end; end;
if locParentIsEnum then begin
IncIndent();
Indent();
WriteLn('property Value : %s read FValue write FValue;',[ASymbol.AncestorType.Name]);
DecIndent();
end;
// //
Indent(); Indent();
@ -2592,9 +2633,27 @@ var
WriteLn('end;'); WriteLn('end;');
end; end;
end; end;
if locParentIsEnum then begin
NewLine();
WriteLn('class function %s.GetEnumTypeInfo() : PTypeInfo;',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.AncestorType.Name]);
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('function %s.GetValueAddress() : Pointer;',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result := @FValue;');
DecIndent();
WriteLn('end;');
end;
end; end;
begin begin
locParentIsEnum := False;
locPropList := TObjectList.Create(False); locPropList := TObjectList.Create(False);
try try
Prepare(); Prepare();

55
wst/trunk/ws_helper/locators.pas
View File

@ -33,20 +33,43 @@ type
private private
FBasePath : string; FBasePath : string;
protected protected
function FindFileName(ADocLocation : string) : string;
property BasePath : string read FBasePath; property BasePath : string read FBasePath;
protected protected
function Find( function Find(
const ADocLocation : string; const ADocLocation : string;
out ADoc : TXMLDocument out ADoc : TXMLDocument
) : Boolean; ) : Boolean;
function FindPath(ADocLocation : string) : string;
function GetBasePath() : string;
procedure SetBasePath(AValue : string);
function Clone() : IDocumentLocator;
public public
constructor Create(const ABasePath : string); constructor Create(const ABasePath : string);virtual;
end; end;
TFileDocumentLocatorClass = class of TFileDocumentLocator;
implementation implementation
{ TFileDocumentLocator } { TFileDocumentLocator }
function TFileDocumentLocator.FindFileName(ADocLocation : string) : string;
var
locFileName : string;
begin
//locFileName := BasePath + ExtractFileName(ADocLocation);
locFileName := StringReplace(ADocLocation,'\',PathDelim,[rfIgnoreCase,rfReplaceAll]);
locFileName := StringReplace(locFileName,'/',PathDelim,[rfIgnoreCase,rfReplaceAll]);
locFileName := BasePath + locFileName;
//locFileName := ExpandFileName(locFileName);
if FileExists(locFileName) then
Result := locFileName
else
Result := '';
end;
function TFileDocumentLocator.Find( function TFileDocumentLocator.Find(
const ADocLocation: string; const ADocLocation: string;
out ADoc: TXMLDocument out ADoc: TXMLDocument
@ -54,16 +77,38 @@ function TFileDocumentLocator.Find(
var var
locFileName : string; locFileName : string;
begin begin
locFileName := BasePath + ExtractFileName(ADocLocation); locFileName := FindFileName(ADocLocation);
locFileName := ExpandFileName(locFileName); Result := (locFileName <> '');
Result := FileExists(locFileName);
if Result then if Result then
ReadXMLFile(ADoc,locFileName); ReadXMLFile(ADoc,locFileName);
end; end;
function TFileDocumentLocator.FindPath(ADocLocation : string) : string;
begin
Result := FindFileName(ADocLocation);
if (Result <> '') then
Result := ExtractFilePath(Result);
end;
function TFileDocumentLocator.GetBasePath() : string;
begin
Result := BasePath;
end;
procedure TFileDocumentLocator.SetBasePath(AValue : string);
begin
if (FBasePath <> AValue) then
FBasePath := AValue;
end;
function TFileDocumentLocator.Clone() : IDocumentLocator;
begin
Result := TFileDocumentLocatorClass(Self.ClassType).Create(FBasePath) as IDocumentLocator;
end;
constructor TFileDocumentLocator.Create(const ABasePath: string); constructor TFileDocumentLocator.Create(const ABasePath: string);
begin begin
FBasePath := IncludeTrailingPathDelimiter(ABasePath); SetBasePath(IncludeTrailingPathDelimiter(ABasePath));
end; end;
end. end.

53
wst/trunk/ws_helper/wsdl_parser.pas
View File

@ -60,9 +60,11 @@ type
FSchemaCursor : IObjectCursor; FSchemaCursor : IObjectCursor;
FOnMessage: TOnParserMessage; FOnMessage: TOnParserMessage;
FSimpleOptions : TParserOptions; FSimpleOptions : TParserOptions;
FIncludeList : TStringList;
private private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
function AddNameSpace(const AValue : string) : TStrings; function AddNameSpace(const AValue : string) : TStrings;
procedure CreateIncludeList();
private private
function CreateWsdlNameFilter(const AName : WideString):IObjectFilter; function CreateWsdlNameFilter(const AName : WideString):IObjectFilter;
function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode;
@ -93,9 +95,11 @@ type
function GetTargetNameSpace() : string; function GetTargetNameSpace() : string;
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions; function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions); procedure SetSimpleOptions(const AValue : TParserOptions);
procedure AddIncludedDoc(ADocLocation : string);
function IsIncludedDoc(ADocLocation : string) : Boolean;
public public
constructor Create( constructor Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
@ -148,6 +152,15 @@ begin
end; end;
end; end;
procedure TWsdlParser.CreateIncludeList();
begin
if (FIncludeList = nil) then begin
FIncludeList := TStringList.Create();
FIncludeList.Duplicates := dupIgnore;
FIncludeList.Sorted := True;
end;
end;
constructor TWsdlParser.Create( constructor TWsdlParser.Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
ASymbols : TwstPasTreeContainer; ASymbols : TwstPasTreeContainer;
@ -193,6 +206,7 @@ destructor TWsdlParser.Destroy();
end; end;
begin begin
FreeAndNil(FIncludeList);
FreeList(FXsdParsers); FreeList(FXsdParsers);
FreeList(FNameSpaceList); FreeList(FNameSpaceList);
inherited; inherited;
@ -285,7 +299,7 @@ begin
Result := FDocumentLocator; Result := FDocumentLocator;
end; end;
procedure TWsdlParser.SetDocumentLocator(const ALocator: IDocumentLocator); procedure TWsdlParser.SetDocumentLocator(ALocator: IDocumentLocator);
begin begin
FDocumentLocator := ALocator; FDocumentLocator := ALocator;
end; end;
@ -301,6 +315,18 @@ begin
FSimpleOptions := AValue; FSimpleOptions := AValue;
end; end;
procedure TWsdlParser.AddIncludedDoc(ADocLocation : string);
begin
if (FIncludeList = nil) then
CreateIncludeList();
FIncludeList.Add(ADocLocation);
end;
function TWsdlParser.IsIncludedDoc(ADocLocation : string) : Boolean;
begin
Result := (FIncludeList <> nil) and (FIncludeList.IndexOf(ADocLocation) <> -1);
end;
function TWsdlParser.GetTargetNameSpace() : string; function TWsdlParser.GetTargetNameSpace() : string;
begin begin
Result := FTargetNameSpace; Result := FTargetNameSpace;
@ -391,6 +417,26 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin
end; end;
end; end;
procedure FixUsesList();
var
locPrs : IParserContext;
k : PtrInt;
locModule : TPasModule;
locIntfUsesList : TList;
begin
locIntfUsesList := FModule.InterfaceSection.UsesList;
for k := 0 to Pred(FXsdParsers.Count) do begin
locPrs := (FXsdParsers.Objects[k] as TIntfObjectRef).Intf as IParserContext;
locModule := locPrs.GetTargetModule();
if (locModule <> nil) and (locModule <> FModule) and
(locIntfUsesList.IndexOf(locModule) = -1)
then begin
locModule.AddRef();
locIntfUsesList.Add(locModule);
end;
end;
end;
var var
locSrvcCrs : IObjectCursor; locSrvcCrs : IObjectCursor;
locObj : TDOMNodeRttiExposer; locObj : TDOMNodeRttiExposer;
@ -409,8 +455,9 @@ begin
end; end;
ParseForwardDeclarations(); ParseForwardDeclarations();
ExtractNameSpace();
SymbolTable.SetCurrentModule(FModule); SymbolTable.SetCurrentModule(FModule);
ExtractNameSpace();
FixUsesList();
end; end;
function TWsdlParser.ParseOperation( function TWsdlParser.ParseOperation(

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

@ -47,6 +47,7 @@ const
s_extension : WideString = 'extension'; s_extension : WideString = 'extension';
s_guid : WideString = 'GUID'; s_guid : WideString = 'GUID';
s_import = 'import'; s_import = 'import';
s_include = 'include';
s_input : WideString = 'input'; s_input : WideString = 'input';
s_item : WideString = 'item'; s_item : WideString = 'item';
s_literal = 'literal'; s_literal = 'literal';

218
wst/trunk/ws_helper/xsd_parser.pas
View File

@ -48,10 +48,16 @@ type
const ADocLocation : string; const ADocLocation : string;
out ADoc : TXMLDocument out ADoc : TXMLDocument
) : Boolean; ) : Boolean;
function FindPath(ADocLocation : string) : string;
function GetBasePath() : string;
procedure SetBasePath(AValue : string);
function Clone() : IDocumentLocator;
end; end;
TParserOption = ( TParserOption = (
poEnumAlwaysPrefix // Always prefix enum item with the enum name poEnumAlwaysPrefix, // Always prefix enum item with the enum name
poParsingIncludeSchema
); );
TParserOptions = set of TParserOption; TParserOptions = set of TParserOption;
IParserContext = interface IParserContext = interface
@ -63,9 +69,12 @@ type
function GetTargetNameSpace() : string; function GetTargetNameSpace() : string;
function GetTargetModule() : TPasModule; function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions; function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions); procedure SetSimpleOptions(const AValue : TParserOptions);
procedure AddIncludedDoc(ADocLocation : string);
function IsIncludedDoc(ADocLocation : string) : Boolean;
end; end;
IXsdPaser = interface IXsdPaser = interface
@ -103,12 +112,15 @@ type
FSimpleOptions : TParserOptions; FSimpleOptions : TParserOptions;
FImportParsed : Boolean; FImportParsed : Boolean;
FXsdParsers : TStringList; FXsdParsers : TStringList;
FIncludeList : TStringList;
FIncludeParsed : Boolean;
FPrepared : Boolean;
private private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
private private
function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode;
function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure Prepare(); procedure Prepare(const AMustSucceed : Boolean);
function FindElement(const AName: String) : TPasElement; {$IFDEF USE_INLINE}inline;{$ENDIF} function FindElement(const AName: String) : TPasElement; {$IFDEF USE_INLINE}inline;{$ENDIF}
protected protected
function GetXsShortNames() : TStrings; function GetXsShortNames() : TStrings;
@ -117,9 +129,11 @@ type
function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings;
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetDocumentLocator() : IDocumentLocator; function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator); procedure SetDocumentLocator(ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions; function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions); procedure SetSimpleOptions(const AValue : TParserOptions);
procedure AddIncludedDoc(ADocLocation : string);
function IsIncludedDoc(ADocLocation : string) : Boolean;
procedure SetNotifier(ANotifier : TOnParserMessage); procedure SetNotifier(ANotifier : TOnParserMessage);
function InternalParseType( function InternalParseType(
@ -128,6 +142,8 @@ type
) : TPasType; ) : TPasType;
procedure CreateImportParsers(); procedure CreateImportParsers();
procedure ParseImportDocuments(); virtual; procedure ParseImportDocuments(); virtual;
procedure CreateIncludeList();
procedure ParseIncludeDocuments(); virtual;
public public
constructor Create( constructor Create(
ADoc : TXMLDocument; ADoc : TXMLDocument;
@ -207,7 +223,7 @@ begin
FNameSpaceList.Duplicates := dupError; FNameSpaceList.Duplicates := dupError;
FNameSpaceList.Sorted := True; FNameSpaceList.Sorted := True;
Prepare(); Prepare(False);
end; end;
destructor TCustomXsdSchemaParser.Destroy(); destructor TCustomXsdSchemaParser.Destroy();
@ -227,6 +243,7 @@ destructor TCustomXsdSchemaParser.Destroy();
begin begin
FParentContext := nil; FParentContext := nil;
FreeAndNil(FIncludeList);
FreeList(FNameSpaceList); FreeList(FNameSpaceList);
FreeList(FXsdParsers); FreeList(FXsdParsers);
inherited; inherited;
@ -237,6 +254,7 @@ var
i : PtrInt; i : PtrInt;
p, p1 : IXsdPaser; p, p1 : IXsdPaser;
begin begin
Prepare(True);
Result := nil; Result := nil;
if (ANamespace = FTargetNameSpace) then begin if (ANamespace = FTargetNameSpace) then begin
Result := Self; Result := Self;
@ -306,6 +324,101 @@ begin
end; end;
end; end;
procedure TCustomXsdSchemaParser.CreateIncludeList();
begin
if (FIncludeList = nil) then begin
FIncludeList := TStringList.Create();
FIncludeList.Duplicates := dupIgnore;
FIncludeList.Sorted := True;
end;
end;
procedure TCustomXsdSchemaParser.ParseIncludeDocuments();
var
crsSchemaChild : IObjectCursor;
strFilter, locFileName : string;
includeNode : TDOMElement;
includeDoc : TXMLDocument;
locParser : IXsdPaser;
locOldCurrentModule : TPasModule;
locLocator, locTempLocator : IDocumentLocator;
locContext : IParserContext;
locUsesList : TList;
locModule : TPasModule;
locName, s : string;
i : Integer;
begin
if FIncludeParsed then
exit;
Prepare(True);
if (poParsingIncludeSchema in FSimpleOptions) then begin
locContext := GetParentContext();
if (locContext = nil) then
raise EXsdParserAssertException.CreateFmt(SERR_InvalidParserState,['"poParsingIncludeSchema" require a parent context']);
if not(IsStrEmpty(FTargetNameSpace)) and (FTargetNameSpace <> locContext.GetTargetNameSpace()) then
raise EXsdParserAssertException.Create(SERR_InvalidIncludeDirectiveNS);
end;
FIncludeParsed := True;
locLocator := GetDocumentLocator();
if (locLocator = nil) then
Exit;
if Assigned(FChildCursor) then begin
locOldCurrentModule := SymbolTable.CurrentModule;
try
locUsesList := FModule.InterfaceSection.UsesList;
crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
strFilter := CreateQualifiedNameFilterStr(s_include,FXSShortNames);
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer));
crsSchemaChild.Reset();
while crsSchemaChild.MoveNext() do begin
includeNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement;
if (includeNode.Attributes <> nil) and (includeNode.Attributes.Length > 0) then begin
locFileName := NodeValue(includeNode.Attributes.GetNamedItem(s_schemaLocation));
if not(IsStrEmpty(locFileName) or IsIncludedDoc(locFileName)) then begin
if locLocator.Find(locFileName,includeDoc) then begin
AddIncludedDoc(locFileName);
locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create(
includeDoc,
includeDoc.DocumentElement,
SymbolTable,
Self as IParserContext
);
locContext := locParser as IParserContext;
locContext.SetSimpleOptions(locContext.GetSimpleOptions() + [poParsingIncludeSchema]);
locTempLocator := locLocator.Clone();
locTempLocator.SetBasePath(locLocator.FindPath(locFileName));
locContext.SetDocumentLocator(locTempLocator);
locParser.SetNotifier(FOnMessage);
locParser.ParseTypes();
locModule := locContext.GetTargetModule();
if (ExtractIdentifier(locContext.GetTargetNameSpace()) = locModule.Name) then begin
s := ChangeFileExt(ExtractFileName(locFileName),'');
i := 1;
locName := s;
while (FSymbols.FindModule(locName) <> nil) do begin
locName := Format('%s%d',[s,i]);
Inc(i);
end;
locModule.Name := locName;
end;
if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin
locModule.AddRef();
locUsesList.Add(locModule);
end;
end else begin
DoOnMessage(mtError,Format(SERR_FileNotFound,[locFileName]));
end;
end;
end;
end;
finally
SymbolTable.SetCurrentModule(locOldCurrentModule);
end;
end;
end;
function TCustomXsdSchemaParser.FindNamedNode( function TCustomXsdSchemaParser.FindNamedNode(
AList : IObjectCursor; AList : IObjectCursor;
const AName : WideString; const AName : WideString;
@ -385,7 +498,7 @@ begin
Result := GetParentContext().GetDocumentLocator(); Result := GetParentContext().GetDocumentLocator();
end; end;
procedure TCustomXsdSchemaParser.SetDocumentLocator(const ALocator: IDocumentLocator); procedure TCustomXsdSchemaParser.SetDocumentLocator(ALocator: IDocumentLocator);
begin begin
FDocumentLocator := ALocator; FDocumentLocator := ALocator;
end; end;
@ -401,6 +514,27 @@ begin
FSimpleOptions := AValue; FSimpleOptions := AValue;
end; end;
procedure TCustomXsdSchemaParser.AddIncludedDoc(ADocLocation : string);
begin
if (poParsingIncludeSchema in FSimpleOptions) then begin
GetParentContext().AddIncludedDoc(ADocLocation);
exit;
end;
if (FIncludeList = nil) then
CreateIncludeList();
FIncludeList.Add(ADocLocation);
end;
function TCustomXsdSchemaParser.IsIncludedDoc(ADocLocation : string) : Boolean;
begin
Result := False;
if (poParsingIncludeSchema in FSimpleOptions) then
Result := GetParentContext().IsIncludedDoc(ADocLocation);
if not Result then
Result := (FIncludeList <> nil) and (FIncludeList.IndexOf(ADocLocation) <> -1);
end;
procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage); procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage);
begin begin
FOnMessage := ANotifier; FOnMessage := ANotifier;
@ -429,11 +563,13 @@ end;
function TCustomXsdSchemaParser.GetTargetModule() : TPasModule; function TCustomXsdSchemaParser.GetTargetModule() : TPasModule;
begin begin
Prepare(True);
Result := FModule; Result := FModule;
end; end;
function TCustomXsdSchemaParser.GetTargetNameSpace() : string; function TCustomXsdSchemaParser.GetTargetNameSpace() : string;
begin begin
Prepare(True);
Result := FTargetNameSpace; Result := FTargetNameSpace;
end; end;
@ -599,8 +735,11 @@ var
typeModule : TPasModule; typeModule : TPasModule;
locTypeNodeFound : Boolean; locTypeNodeFound : Boolean;
begin begin
Prepare(True);
if not FImportParsed then if not FImportParsed then
ParseImportDocuments(); ParseImportDocuments();
if not FIncludeParsed then
ParseIncludeDocuments();
sct := nil; sct := nil;
DoOnMessage(mtInfo, Format(SERR_Parsing,[AName])); DoOnMessage(mtInfo, Format(SERR_Parsing,[AName]));
try try
@ -682,10 +821,16 @@ var
locParser : IXsdPaser; locParser : IXsdPaser;
locOldCurrentModule : TPasModule; locOldCurrentModule : TPasModule;
locContinue : Boolean; locContinue : Boolean;
locLocator : IDocumentLocator; locLocator, loctempLocator : IDocumentLocator;
locContext : IParserContext;
locUsesList : TList;
locModule : TPasModule;
locName, s : string;
i : Integer;
begin begin
if FImportParsed then if FImportParsed then
Exit; Exit;
Prepare(True);
locLocator := GetDocumentLocator(); locLocator := GetDocumentLocator();
if (locLocator = nil) then if (locLocator = nil) then
Exit; Exit;
@ -693,6 +838,7 @@ begin
if Assigned(FChildCursor) then begin if Assigned(FChildCursor) then begin
locOldCurrentModule := SymbolTable.CurrentModule; locOldCurrentModule := SymbolTable.CurrentModule;
try try
locUsesList := FModule.InterfaceSection.UsesList;
crsSchemaChild := FChildCursor.Clone() as IObjectCursor; crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
strFilter := CreateQualifiedNameFilterStr(s_import,FXSShortNames); strFilter := CreateQualifiedNameFilterStr(s_import,FXSShortNames);
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer)); crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer));
@ -701,9 +847,8 @@ begin
importNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement; importNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement;
if ( importNode.Attributes <> nil ) and ( importNode.Attributes.Length > 0 ) then begin if ( importNode.Attributes <> nil ) and ( importNode.Attributes.Length > 0 ) then begin
locFileName := NodeValue(importNode.Attributes.GetNamedItem(s_schemaLocation)); locFileName := NodeValue(importNode.Attributes.GetNamedItem(s_schemaLocation));
if ( not IsStrEmpty(locFileName) ) and if not IsStrEmpty(locFileName) then begin
locLocator.Find(locFileName,importDoc) if locLocator.Find(locFileName,importDoc) then begin
then begin
locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace)); locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace));
locContinue := IsStrEmpty(locNameSpace) or (FXsdParsers = nil) or (FXsdParsers.IndexOf(locNameSpace) = -1);//( SymbolTable.FindModule(locNameSpace) = nil ); locContinue := IsStrEmpty(locNameSpace) or (FXsdParsers = nil) or (FXsdParsers.IndexOf(locNameSpace) = -1);//( SymbolTable.FindModule(locNameSpace) = nil );
if locContinue then begin if locContinue then begin
@ -718,9 +863,29 @@ begin
SymbolTable, SymbolTable,
Self as IParserContext Self as IParserContext
); );
locContext := locParser as IParserContext;
loctempLocator := locLocator.Clone();
loctempLocator.SetBasePath(locLocator.FindPath(locFileName));
locContext.SetDocumentLocator(loctempLocator);
FXsdParsers.AddObject(locNameSpace,TIntfObjectRef.Create(locParser)); FXsdParsers.AddObject(locNameSpace,TIntfObjectRef.Create(locParser));
locParser.SetNotifier(FOnMessage); locParser.SetNotifier(FOnMessage);
//locParser.ParseTypes(); //locParser.ParseTypes();
locModule := locContext.GetTargetModule();
if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin
s := ChangeFileExt(ExtractFileName(locFileName),'');
i := 1;
locName := s;
while (FSymbols.FindModule(locName) <> nil) do begin
locName := Format('%s%d',[s,i]);
Inc(i);
end;
locModule.Name := locName;
locModule.AddRef();
locUsesList.Add(locModule);
end;
end;
end else begin
DoOnMessage(mtError,Format(SERR_FileNotFound,[locFileName]));
end; end;
end; end;
end; end;
@ -737,6 +902,8 @@ var
typFilterStr : string; typFilterStr : string;
typNode : TDOMNode; typNode : TDOMNode;
begin begin
Prepare(True);
ParseIncludeDocuments();
if Assigned(FChildCursor) then begin if Assigned(FChildCursor) then begin
crsSchemaChild := FChildCursor.Clone() as IObjectCursor; crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
typFilterStr := Format( typFilterStr := Format(
@ -766,20 +933,40 @@ begin
end; end;
end; end;
procedure TCustomXsdSchemaParser.Prepare(); procedure TCustomXsdSchemaParser.Prepare(const AMustSucceed : Boolean);
var var
locAttCursor : IObjectCursor; locAttCursor : IObjectCursor;
prntCtx : IParserContext; prntCtx : IParserContext;
nd : TDOMNode; nd : TDOMNode;
i : PtrInt; i : PtrInt;
ls : TStrings; ls : TStrings;
ok : Boolean;
begin begin
if ( FSchemaNode.Attributes = nil ) or ( GetNodeListCount(FSchemaNode.Attributes) = 0 ) then if FPrepared then
raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]); exit;
FTargetNameSpace := '';
ok := False;
if (FSchemaNode.Attributes <> nil) and (GetNodeListCount(FSchemaNode.Attributes) > 0) then begin
nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace); nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace);
if ( nd = nil ) then if (nd <> nil) then begin
raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]);
FTargetNameSpace := nd.NodeValue; FTargetNameSpace := nd.NodeValue;
ok := True;
end;
end;
prntCtx := GetParentContext();
if not ok then begin
if (poParsingIncludeSchema in FSimpleOptions) and (prntCtx <> nil) then begin
FTargetNameSpace := prntCtx.GetTargetNameSpace();
ok := True;
end else begin
if not AMustSucceed then
exit;
raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]);
end;
end;
FPrepared := True;
if IsStrEmpty(FModuleName) then if IsStrEmpty(FModuleName) then
FModuleName := ExtractIdentifier(FTargetNameSpace); FModuleName := ExtractIdentifier(FTargetNameSpace);
if ( SymbolTable.FindModule(s_xs) = nil ) then begin if ( SymbolTable.FindModule(s_xs) = nil ) then begin
@ -790,7 +977,6 @@ begin
locAttCursor := CreateAttributesCursor(FSchemaNode,cetRttiNode); locAttCursor := CreateAttributesCursor(FSchemaNode,cetRttiNode);
BuildNameSpaceList(locAttCursor,FNameSpaceList); BuildNameSpaceList(locAttCursor,FNameSpaceList);
FXSShortNames := FindShortNamesForNameSpaceLocal(s_xs); FXSShortNames := FindShortNamesForNameSpaceLocal(s_xs);
prntCtx := GetParentContext();
if ( FXSShortNames = nil ) then begin if ( FXSShortNames = nil ) then begin
if ( prntCtx = nil ) then if ( prntCtx = nil ) then
raise EXsdParserAssertException.CreateFmt(SERR_InvalidSchemaDoc_NamespaceNotFound,[s_xs]); raise EXsdParserAssertException.CreateFmt(SERR_InvalidSchemaDoc_NamespaceNotFound,[s_xs]);

5
wst/trunk/wst_consts.pas
View File

@ -32,6 +32,7 @@ resourcestring
SERR_ExpectedTypeDefinition = '"%s" was expected to be a type definition.'; SERR_ExpectedTypeDefinition = '"%s" was expected to be a type definition.';
SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".'; SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".';
SERR_FailedTransportRequest = '%s Request to %s failed.'; SERR_FailedTransportRequest = '%s Request to %s failed.';
SERR_FileNotFound = 'File not found : "%s" .';
SERR_HeaderNotUnderstood = 'Header "%s" not Understood.'; SERR_HeaderNotUnderstood = 'Header "%s" not Understood.';
SERR_IllegalChar = 'Illegal character for that encoding : "%s".'; SERR_IllegalChar = 'Illegal character for that encoding : "%s".';
SERR_IndexOutOfBound = 'Index out of bound : %d.'; SERR_IndexOutOfBound = 'Index out of bound : %d.';
@ -57,11 +58,13 @@ resourcestring
SERR_InvalidEncodedData = 'Invalid encoded data.'; SERR_InvalidEncodedData = 'Invalid encoded data.';
SERR_InvalidEnumItemNode_NoValueAttribute = 'Invalid "enum" item node : no value attribute, type = "%s".'; SERR_InvalidEnumItemNode_NoValueAttribute = 'Invalid "enum" item node : no value attribute, type = "%s".';
SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.'; SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.';
SERR_InvalidIncludeDirectiveNS = 'Invalid <include> directive, "targetNamespace" must be absent or equals the parent''s one.';
SERR_InvalidMaxOccursValue = 'Invalid "maxOccurs" value : "%s.%s".'; SERR_InvalidMaxOccursValue = 'Invalid "maxOccurs" value : "%s.%s".';
SERR_InvalidMinOccursValue = 'Invalid "minOccurs" value : "%s.%s".'; SERR_InvalidMinOccursValue = 'Invalid "minOccurs" value : "%s.%s".';
SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.'; SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.';
SERR_InvalidEmbeddedScopeOperation = 'Invalid opération on scope, their are no embedded scope.'; SERR_InvalidEmbeddedScopeOperation = 'Invalid operation on scope, their are no embedded scope.';
SERR_InvalidParameter = 'Invalid parameter : "%s".'; SERR_InvalidParameter = 'Invalid parameter : "%s".';
SERR_InvalidParserState = 'Invalud parser state : %s.';
SERR_InvalidPropertyValue = 'Invalid property ("%s") value : "%s".'; SERR_InvalidPropertyValue = 'Invalid property ("%s") value : "%s".';
SERR_InvalidParameterProc = 'Invalid parameter : "%s"; Procedure = "%s".'; SERR_InvalidParameterProc = 'Invalid parameter : "%s"; Procedure = "%s".';
SERR_InvalidParameters = 'Invalid parameters.'; SERR_InvalidParameters = 'Invalid parameters.';