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

XSD <any> and <anyAttribute> handling

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@598 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2008-10-23 19:21:59 +00:00
parent cfba265867
commit 83f0425897
10 changed files with 817 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
wst/trunk/tests/test_suite/files/complex_class_open_type.wsdl Normal file
View File

@ -0,0 +1,54 @@
<?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:complexType name="TClass_1">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:any processContents="lax" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
<xsd:anyAttribute processContents="strict"/>
</xsd:complexType>
<xsd:complexType name="TClassSampleTypeAll">
<xsd:all>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:all>
<xsd:attribute name="strAtt" type="xsd:string"/>
<xsd:anyAttribute processContents="skip"/>
</xsd:complexType>
<xsd:complexType name="TClass_2">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:string" />
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TClassSampleDerivedType">
<xsd:complexContent>
<xsd:extension base="tns:TClass_2">
<xsd:sequence>
<xsd:element name="intFieldEx" type="xsd:int" />
<xsd:element name="strFieldEx" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:any processContents="skip" maxOccurs="unbounded"/>
</xsd:sequence>
<xsd:attribute name="strAttEx" type="xsd:string"/>
<xsd:attribute name="intAttEx" type="xsd:int"/>
<xsd:anyAttribute processContents="lax"/>
</xsd:extension>
</xsd:complexContent>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

44
wst/trunk/tests/test_suite/files/complex_class_open_type.xsd Normal file
View File

@ -0,0 +1,44 @@
<?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="TClass_1">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:any processContents="lax" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
<xsd:anyAttribute processContents="strict"/>
</xsd:complexType>
<xsd:complexType name="TClassSampleTypeAll">
<xsd:all>
<xsd:element name="intField" type="xsd:int" />
<xsd:element name="strField" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:all>
<xsd:attribute name="strAtt" type="xsd:string"/>
<xsd:anyAttribute processContents="skip"/>
</xsd:complexType>
<xsd:complexType name="TClass_2">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:string" />
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TClassSampleDerivedType">
<xsd:complexContent>
<xsd:extension base="n:TClass_2">
<xsd:sequence>
<xsd:element name="intFieldEx" type="xsd:int" />
<xsd:element name="strFieldEx" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:any processContents="skip" maxOccurs="unbounded"/>
</xsd:sequence>
<xsd:attribute name="strAttEx" type="xsd:string"/>
<xsd:attribute name="intAttEx" type="xsd:int"/>
<xsd:anyAttribute processContents="lax"/>
</xsd:extension>
</xsd:complexContent>
</xsd:complexType>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any.xsd Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0"?>
<schema xmlns:tns="urn:wst-test" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xsd:complexType name="TComplexType">
<xsd:sequence>
<xsd:any maxOccurs="unbounded" minOccurs="0" processContents="lax"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TComplexType2">
<xsd:sequence>
<xsd:element name="strField" type="xsd:string"/>
<xsd:any maxOccurs="unbounded" minOccurs="0" processContents="lax"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldParent" type="xsd:string"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TComplexTypeChild">
<xsd:extension base="tns:TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldChild" type="xsd:string"/>
<xsd:any maxOccurs="10" minOccurs="2" processContents="skip"/>
</xsd:sequence>
</xsd:extension>
</xsd:complexType>
</schema>

33
wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_anyatt.xsd Normal file
View File

@ -0,0 +1,33 @@
<?xml version="1.0"?>
<schema xmlns:tns="urn:wst-test" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xsd:complexType name="TComplexType">
<xsd:sequence>
<xsd:any maxOccurs="unbounded" minOccurs="0" processContents="lax"/>
</xsd:sequence>
<xsd:anyAttribute processContents="lax"/>
</xsd:complexType>
<xsd:complexType name="TComplexType2">
<xsd:sequence>
<xsd:element name="strField" type="xsd:string"/>
<xsd:element name="strFieldAtt" type="xsd:string"/>
<xsd:any maxOccurs="unbounded" minOccurs="0" processContents="lax"/>
</xsd:sequence>
<xsd:anyAttribute processContents="strict"/>
</xsd:complexType>
<xsd:complexType name="TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldParent" type="xsd:string"/>
<xsd:element name="strFieldParentAtt" type="xsd:string"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TComplexTypeChild">
<xsd:extension base="tns:TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldChild" type="xsd:string"/>
<xsd:element name="strFieldChildAtt" type="xsd:string"/>
<xsd:any maxOccurs="10" minOccurs="2" processContents="skip"/>
</xsd:sequence>
</xsd:extension>
<xsd:anyAttribute processContents="skip"/>
</xsd:complexType>
</schema>

28
wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_attribute.xsd Normal file
View File

@ -0,0 +1,28 @@
<?xml version="1.0"?>
<schema xmlns:tns="urn:wst-test" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xsd:complexType name="TComplexType">
<xsd:anyAttribute processContents="lax"/>
</xsd:complexType>
<xsd:complexType name="TComplexType2">
<xsd:sequence>
<xsd:element name="strField" type="xsd:string"/>
<xsd:element name="strFieldAtt" type="xsd:string"/>
</xsd:sequence>
<xsd:anyAttribute processContents="strict"/>
</xsd:complexType>
<xsd:complexType name="TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldParent" type="xsd:string"/>
<xsd:element name="strFieldParentAtt" type="xsd:string"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TComplexTypeChild">
<xsd:extension base="tns:TComplexTypeParent">
<xsd:sequence>
<xsd:element name="strFieldChild" type="xsd:string"/>
<xsd:element name="strFieldChildAtt" type="xsd:string"/>
</xsd:sequence>
</xsd:extension>
<xsd:anyAttribute processContents="skip"/>
</xsd:complexType>
</schema>

276
wst/trunk/tests/test_suite/test_generators.pas
View File

@ -44,6 +44,9 @@ type
{$ENDIF WST_UNICODESTRING}
procedure array_sequence_collection();
procedure class_sequence_open_type_any();
procedure class_sequence_open_type_any_attribute();
procedure class_sequence_open_type_any_any_attribute();
end;
TTest_XsdGenerator = class(TTest_CustomXsdGenerator)
@ -565,6 +568,279 @@ begin
end;
end;
procedure TTest_CustomXsdGenerator.class_sequence_open_type_any();
var
tr : TwstPasTreeContainer;
procedure AddProperty(
AClassType : TPasClassType;
const AName,
ATypeName : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,AClassType,visDefault,'',0));
AClassType.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
mdl : TPasModule;
cltyp : TPasClassType;
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'open_type_module',tr.Package,visDefault,'',0));
tr.RegisterExternalAlias(mdl,'urn:wst-test');
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=lax;minOccurs=0;maxOccurs=unbounded');
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType2',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=lax;minOccurs=0;maxOccurs=unbounded');
AddProperty(cltyp,'strField','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeParent',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty(cltyp,'strFieldParent','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeChild',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElement('TComplexTypeParent') as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=skip;minOccurs=2;maxOccurs=10');
AddProperty(cltyp,'strFieldChild','string',ptField);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
//WriteXML(locDoc,'gen_class_sequence_open_type_any.xsd');
locExistDoc := LoadXmlFromFilesList('gen_class_sequence_open_type_any.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdGenerator.class_sequence_open_type_any_attribute();
var
tr : TwstPasTreeContainer;
procedure AddProperty(
AClassType : TPasClassType;
const AName,
ATypeName : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,AClassType,visDefault,'',0));
AClassType.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
mdl : TPasModule;
cltyp : TPasClassType;
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'open_type_module',tr.Package,visDefault,'',0));
tr.RegisterExternalAlias(mdl,'urn:wst-test');
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=lax');
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType2',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=strict');
AddProperty(cltyp,'strField','string',ptField);
AddProperty(cltyp,'strFieldAtt','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeParent',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty(cltyp,'strFieldParent','string',ptField);
AddProperty(cltyp,'strFieldParentAtt','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeChild',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElement('TComplexTypeParent') as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=skip');
AddProperty(cltyp,'strFieldChild','string',ptField);
AddProperty(cltyp,'strFieldChildAtt','string',ptField);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
//WriteXML(locDoc,'gen_class_sequence_open_type_any_attribute.xsd');
locExistDoc := LoadXmlFromFilesList('gen_class_sequence_open_type_any_attribute.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
procedure TTest_CustomXsdGenerator.class_sequence_open_type_any_any_attribute();
var
tr : TwstPasTreeContainer;
procedure AddProperty(
AClassType : TPasClassType;
const AName,
ATypeName : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,AClassType,visDefault,'',0));
AClassType.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
mdl : TPasModule;
cltyp : TPasClassType;
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'open_type_module',tr.Package,visDefault,'',0));
tr.RegisterExternalAlias(mdl,'urn:wst-test');
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=lax');
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=lax;minOccurs=0;maxOccurs=unbounded');
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexType2',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=strict');
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=lax;minOccurs=0;maxOccurs=unbounded');
AddProperty(cltyp,'strField','string',ptField);
AddProperty(cltyp,'strFieldAtt','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeParent',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElementNS('TBaseComplexRemotable',s_xs) as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty(cltyp,'strFieldParent','string',ptField);
AddProperty(cltyp,'strFieldParentAtt','string',ptField);
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TComplexTypeChild',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
cltyp.AncestorType := tr.FindElement('TComplexTypeParent') as TPasType;
cltyp.AncestorType.AddRef();
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_anyAttribute]),'processContents=skip');
tr.Properties.SetValue(cltyp,Format('%s#%s',[s_xs,s_any]),'processContents=skip;minOccurs=2;maxOccurs=10');
AddProperty(cltyp,'strFieldChild','string',ptField);
AddProperty(cltyp,'strFieldChildAtt','string',ptField);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
//WriteXML(locDoc,'gen_class_sequence_open_type_any_anyatt.xsd');
locExistDoc := LoadXmlFromFilesList('gen_class_sequence_open_type_any_anyatt.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
function TTest_CustomXsdGenerator.LoadXmlFromFilesList(const AFileName: string): TXMLDocument;
begin
ReadXMLFile(Result,wstExpandLocalFileName(TestFilesPath + AFileName));

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

@ -40,6 +40,7 @@ type
function LoadComplexType_Class_properties_extended_metadata2() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract;
@ -68,6 +69,11 @@ type
procedure ComplexType_Class_properties_extended_metadata2();
procedure ComplexType_Class_Embedded();
procedure ComplexType_Class_Extend_Simple_Schema();
procedure ComplexType_Class_open_type_any();
procedure ComplexType_Class_open_extension_type_any();
procedure ComplexType_Class_open_extension_type_anyAttribute();
procedure ComplexType_Class_sequence_open_type_anyAttribute();
procedure ComplexType_Class_all_open_type_anyAttribute();
procedure ComplexType_Record();
procedure ComplexType_Record_Embedded();
@ -102,6 +108,7 @@ type
function LoadComplexType_Class_properties_extended_metadata2() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
@ -137,6 +144,7 @@ type
function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override;
function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override;
@ -162,7 +170,7 @@ type
end;
implementation
uses parserutils;
uses parserutils, xsd_consts;
const
x_complexType_SampleArrayIntFieldType = 'TArrayIntFieldType';
@ -685,6 +693,149 @@ begin
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_open_type_any();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
mdl : TPasModule;
elt : TPasElement;
strBuffer : string;
ls : TStringList;
begin
tr := LoadComplexType_Class_OpenType();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
elt := tr.FindElement('TClass_1');
CheckNotNull(elt,'TClass_1');
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_any]));
Check(Length(strBuffer) > 0, s_any);
ls := TStringList.Create();
try
ls.Delimiter := ';';
ls.DelimitedText := strBuffer;
CheckEquals('lax',ls.Values[s_processContents]);
CheckEquals('0',ls.Values[s_minOccurs]);
CheckEquals(s_unbounded,ls.Values[s_maxOccurs]);
finally
ls.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_open_extension_type_any();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
mdl : TPasModule;
elt : TPasElement;
strBuffer : string;
ls : TStringList;
begin
tr := LoadComplexType_Class_OpenType();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
elt := tr.FindElement('TClassSampleDerivedType');
CheckNotNull(elt,'TClassSampleDerivedType');
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_any]));
Check(Length(strBuffer) > 0, s_any);
ls := TStringList.Create();
try
ls.Delimiter := ';';
ls.DelimitedText := strBuffer;
CheckEquals('skip',ls.Values[s_processContents]);
CheckEquals(s_unbounded,ls.Values[s_maxOccurs]);
finally
ls.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_open_extension_type_anyAttribute();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
mdl : TPasModule;
elt : TPasElement;
strBuffer : string;
ls : TStringList;
begin
tr := LoadComplexType_Class_OpenType();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
elt := tr.FindElement('TClassSampleDerivedType');
CheckNotNull(elt,'TClassSampleDerivedType');
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
Check(Length(strBuffer) > 0, s_anyAttribute);
ls := TStringList.Create();
try
ls.Delimiter := ';';
ls.DelimitedText := strBuffer;
CheckEquals('lax',ls.Values[s_processContents]);
finally
ls.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_sequence_open_type_anyAttribute();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
mdl : TPasModule;
elt : TPasElement;
strBuffer : string;
ls : TStringList;
begin
tr := LoadComplexType_Class_OpenType();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
elt := tr.FindElement('TClass_1');
CheckNotNull(elt,'TClass_1');
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
Check(Length(strBuffer) > 0, s_anyAttribute);
ls := TStringList.Create();
try
ls.Delimiter := ';';
ls.DelimitedText := strBuffer;
CheckEquals('strict',ls.Values[s_processContents]);
finally
ls.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_all_open_type_anyAttribute();
var
tr : TwstPasTreeContainer;
clsType : TPasClassType;
mdl : TPasModule;
elt : TPasElement;
strBuffer : string;
ls : TStringList;
begin
tr := LoadComplexType_Class_OpenType();
mdl := tr.FindModule(x_targetNamespace);
CheckNotNull(mdl);
elt := tr.FindElement('TClassSampleTypeAll');
CheckNotNull(elt,'TClassSampleTypeAll');
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
strBuffer := tr.Properties.GetValue(clsType,Format('%s#%s',[s_xs,s_anyAttribute]));
Check(Length(strBuffer) > 0, s_anyAttribute);
ls := TStringList.Create();
try
ls.Delimiter := ';';
ls.DelimitedText := strBuffer;
CheckEquals('skip',ls.Values[s_processContents]);
finally
ls.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Record();
var
tr : TwstPasTreeContainer;
@ -1417,7 +1568,7 @@ begin
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_properties_extended_metadata2;
procedure TTest_CustomXsdParser.ComplexType_Class_properties_extended_metadata2();
const s_ProjectType = 'ProjectType';
var
tr : TwstPasTreeContainer;
@ -1515,6 +1666,11 @@ begin
Result := ParseDoc(x_complexType_extend_simple);
end;
function TTest_XsdParser.LoadComplexType_Class_OpenType( ): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_open_type');
end;
function TTest_XsdParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_record);
@ -1635,6 +1791,11 @@ begin
Result := ParseDoc(x_complexType_extend_simple);
end;
function TTest_WsdlParser.LoadComplexType_Class_OpenType(): TwstPasTreeContainer;
begin
Result := ParseDoc('complex_class_open_type');
end;
function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_record);

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

@ -120,7 +120,10 @@ type
FHints : TParserTypeHints;
private
//helper routines
function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor;
function ExtractElementCursor(
out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
):IObjectCursor;
procedure ExtractExtendedMetadata(const AItem : TPasElement; const ANode : TDOMNode);
procedure GenerateArrayTypes(
const AClassName : string;
@ -403,13 +406,76 @@ end;
{ TComplexTypeParser }
function TComplexTypeParser.ExtractElementCursor(out AAttCursor : IObjectCursor) : IObjectCursor;
function TComplexTypeParser.ExtractElementCursor(
out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
) : IObjectCursor;
var
frstCrsr, tmpCursor : IObjectCursor;
parentNode, tmpNode : TDOMNode;
frstCrsr : IObjectCursor;
function ParseContent_ALL() : IObjectCursor;
var
locTmpCrs : IObjectCursor;
locTmpNode : TDOMNode;
begin
locTmpCrs := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
locTmpCrs.Reset();
if locTmpCrs.MoveNext() then begin
FSequenceType := stElement;
locTmpNode := (locTmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if locTmpNode.HasChildNodes() then begin
locTmpCrs := CreateCursorOn(
CreateChildrenCursor(locTmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := locTmpCrs;
end;
end;
end;
function ParseContent_SEQUENCE(out ARes : IObjectCursor) : Boolean;
var
tmpCursor : IObjectCursor;
tmpNode : TDOMNode;
begin
ARes := nil;
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
Result := tmpCursor.MoveNext();
if Result then begin
FSequenceType := stElement;
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
ARes := tmpCursor;
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_any,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
if tmpCursor.MoveNext() then
AAnyNode := TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject;
end;
end
end;
var
parentNode : TDOMNode;
crs : IObjectCursor;
begin
Result := nil;
AAttCursor := nil;
AAnyNode := nil;
AAnyAttNode := nil;
case FDerivationMode of
dmNone : parentNode := FContentNode;
dmRestriction,
@ -420,42 +486,21 @@ begin
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
crs := CreateChildrenCursor(parentNode,cetRttiNode);
if ( crs <> nil ) then begin
crs := CreateCursorOn(
crs,
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( crs <> nil ) then begin
crs.Reset();
if crs.MoveNext() then
AAnyAttNode := TDOMNodeRttiExposer(crs.GetCurrent()).InnerObject;
end;
end;
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
FSequenceType := stElement;
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := tmpCursor;
end;
end else begin
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
FSequenceType := stElement;
tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
if tmpNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := tmpCursor;
end;
end;
end
end else begin
Result := nil;
if not ParseContent_SEQUENCE(Result) then
Result := ParseContent_ALL();
end;
end;
@ -952,6 +997,40 @@ var
FSymbols.Properties.GetList(ADesc).Assign(ls);
end;
procedure ProcessXsdAnyDeclarations(AAnyNode, AAnyAttNode : TDOMNode; AType : TPasType);
var
anyElt : TDOMElement;
ls : TStringList;
anyDec : string;
begin
if ( AAnyNode <> nil ) then begin
anyElt := AAnyNode as TDOMElement;
ls := TStringList.Create();
try
if anyElt.hasAttribute(s_processContents) then
ls.Values[s_processContents] := anyElt.GetAttribute(s_processContents);
if anyElt.hasAttribute(s_minOccurs) then
ls.Values[s_minOccurs] := anyElt.GetAttribute(s_minOccurs);
if anyElt.hasAttribute(s_maxOccurs) then
ls.Values[s_maxOccurs] := anyElt.GetAttribute(s_maxOccurs);
if ( ls.Count > 0 ) then begin
ls.Delimiter := ';';
anyDec := ls.DelimitedText;
end;
finally
ls.Free();
end;
FSymbols.Properties.SetValue(AType,Format('%s#%s',[s_xs,s_any]),anyDec);
end;
if ( AAnyAttNode <> nil ) then begin
anyDec := '';
anyElt := AAnyAttNode as TDOMElement;
if anyElt.hasAttribute(s_processContents) then
anyDec := anyElt.GetAttribute(s_processContents);
FSymbols.Properties.SetValue(AType,Format('%s#%s',[s_xs,s_anyAttribute]),Format('%s=%s',[s_processContents,anyDec]));
end;
end;
var
eltCrs, eltAttCrs : IObjectCursor;
internalName : string;
@ -963,9 +1042,10 @@ var
recordType : TPasRecordType;
tmpRecVar : TPasVariable;
locStrBuffer : string;
locAnyNode, locAnyAttNode : TDOMNode;
begin
ExtractBaseType();
eltCrs := ExtractElementCursor(eltAttCrs);
eltCrs := ExtractElementCursor(eltAttCrs,locAnyNode,locAnyAttNode);
internalName := ExtractIdentifier(ATypeName);
hasInternalName := IsReservedKeyWord(internalName) or
@ -1091,6 +1171,9 @@ begin
FSymbols.FreeProperties(tmpClassDef);
FreeAndNil(tmpClassDef);
end;
if ( locAnyNode <> nil ) or ( locAnyAttNode <> nil ) then
ProcessXsdAnyDeclarations(locAnyNode,locAnyAttNode,Result);
except
FSymbols.FreeProperties(Result);
FreeAndNil(Result);

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

@ -25,6 +25,8 @@ const
s_address : WideString = 'address';
s_all : WideString = 'all';
s_annotation : WideString = 'annotation';
s_any = 'any';
s_anyAttribute = 'anyAttribute';
s_anyURI = 'anyURI';
s_appinfo : WideString = 'appinfo';
s_array : WideString = 'array';
@ -59,6 +61,7 @@ const
s_part : WideString = 'part';
s_port : WideString = 'port';
s_portType = 'portType';
s_processContents = 'processContents';
s_prohibited = 'prohibited';
s_ref : WideString = 'ref';

68
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -774,6 +774,50 @@ procedure TClassTypeDefinition_TypeHandler.Generate(
end;
end;
procedure ProcessXsdAny(const AContentNode : TDOMElement; const AXsdInfo : string);
var
xsdAnyNode : TDOMElement;
ss : string;
locLS : TStringList;
begin
xsdAnyNode := CreateElement(Format('%s:%s',[s_xs_short,s_any]),AContentNode,ADocument);
locLS := TStringList.Create();
try
locLS.Delimiter := ';';
locLS.DelimitedText := AXsdInfo;
ss := locLS.Values[s_processContents];
if not IsStrEmpty(ss) then
xsdAnyNode.SetAttribute(s_processContents,ss);
ss := locLS.Values[s_minOccurs];
if not IsStrEmpty(ss) then
xsdAnyNode.SetAttribute(s_minOccurs,ss);
ss := locLS.Values[s_maxOccurs];
if not IsStrEmpty(ss) then
xsdAnyNode.SetAttribute(s_maxOccurs,ss);
finally
locLS.Free();
end;
end;
procedure ProcessXsdAnyAttribute(const AContentNode : TDOMElement; const AXsdInfo : string);
var
xsdAnyNode : TDOMElement;
ss : string;
locLS : TStringList;
begin
xsdAnyNode := CreateElement(Format('%s:%s',[s_xs_short,s_anyAttribute]),AContentNode,ADocument);
locLS := TStringList.Create();
try
locLS.Delimiter := ';';
locLS.DelimitedText := AXsdInfo;
ss := locLS.Values[s_processContents];
if not IsStrEmpty(ss) then
xsdAnyNode.SetAttribute(s_processContents,ss);
finally
locLS.Free();
end;
end;
var
cplxNode, sqcNode, derivationNode, defSchemaNode : TDOMElement;
@ -848,9 +892,9 @@ var
typeCategory : TTypeCategory;
hasSequence : Boolean;
trueParent : TPasType;
{$IFDEF WST_HANDLE_DOC}
hasXsdAny, hasXsdAnyAtt : Boolean;
xsdAnyString, xsdAnyAttString : string;
ls : TStrings;
{$ENDIF WST_HANDLE_DOC}
begin
inherited;
typItm := ASymbol as TPasClassType;
@ -912,6 +956,22 @@ begin
end;
if ( typItm.Members.Count > 0 ) then
hasSequence := TypeHasSequence(typItm,typeCategory);
hasXsdAny := False;
hasXsdAnyAtt := False;
if ( typeCategory = tcComplexContent ) then begin
ls := AContainer.Properties.FindList(typItm);
i := ls.IndexOfName(Format('%s#%s',[s_xs,s_any]));
hasXsdAny := ( i > 0 );
if hasXsdAny then begin
xsdAnyString := ls.ValueFromIndex[i];
if not hasSequence then
hasSequence := True;
end;
i := ls.IndexOfName(Format('%s#%s',[s_xs,s_anyAttribute]));
hasXsdAnyAtt := ( i > 0 );
if hasXsdAnyAtt then
xsdAnyAttString := ls.ValueFromIndex[i];
end;
if hasSequence then begin
s := Format('%s:%s',[s_xs_short,s_sequence]);
if Assigned(derivationNode) then
@ -926,6 +986,10 @@ begin
if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then
ProcessProperty(TPasProperty(typItm.Members[i]));
end;
if hasXsdAny then
ProcessXsdAny(sqcNode,xsdAnyString);
if hasXsdAnyAtt then
ProcessXsdAnyAttribute(cplxNode,xsdAnyAttString);
end;
end;