From 83f04258973530130a14a641152889eed7ce2eef Mon Sep 17 00:00:00 2001 From: inoussa Date: Thu, 23 Oct 2008 19:21:59 +0000 Subject: [PATCH] XSD and handling git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@598 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../files/complex_class_open_type.wsdl | 54 ++++ .../files/complex_class_open_type.xsd | 44 +++ .../gen_class_sequence_open_type_any.xsd | 27 ++ ...en_class_sequence_open_type_any_anyatt.xsd | 33 +++ ...class_sequence_open_type_any_attribute.xsd | 28 ++ .../tests/test_suite/test_generators.pas | 276 ++++++++++++++++++ wst/trunk/tests/test_suite/test_parsers.pas | 165 ++++++++++- wst/trunk/ws_helper/ws_parser_imp.pas | 163 ++++++++--- wst/trunk/ws_helper/xsd_consts.pas | 3 + wst/trunk/ws_helper/xsd_generator.pas | 68 ++++- 10 files changed, 817 insertions(+), 44 deletions(-) create mode 100644 wst/trunk/tests/test_suite/files/complex_class_open_type.wsdl create mode 100644 wst/trunk/tests/test_suite/files/complex_class_open_type.xsd create mode 100644 wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any.xsd create mode 100644 wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_anyatt.xsd create mode 100644 wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_attribute.xsd diff --git a/wst/trunk/tests/test_suite/files/complex_class_open_type.wsdl b/wst/trunk/tests/test_suite/files/complex_class_open_type.wsdl new file mode 100644 index 000000000..794fd520a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_open_type.wsdl @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_open_type.xsd b/wst/trunk/tests/test_suite/files/complex_class_open_type.xsd new file mode 100644 index 000000000..a121aa5fd --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_open_type.xsd @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any.xsd b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any.xsd new file mode 100644 index 000000000..6c62010b6 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any.xsd @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_anyatt.xsd b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_anyatt.xsd new file mode 100644 index 000000000..80f065cd5 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_anyatt.xsd @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_attribute.xsd b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_attribute.xsd new file mode 100644 index 000000000..1512f8ae7 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/gen_class_sequence_open_type_any_attribute.xsd @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index 6c27a3160..7d3b9181c 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -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)); diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 0c3126f6b..17b9254a8 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -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); diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index 832b188be..a2f7bca52 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -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); diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 3096bf46a..855f002de 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -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'; diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index c606239e8..f2fa5539b 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -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;