diff --git a/wst/trunk/tests/test_suite/files/case_sensitive.wsdl b/wst/trunk/tests/test_suite/files/case_sensitive.wsdl new file mode 100644 index 000000000..d2b976ea9 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive.wsdl @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/case_sensitive.xsd b/wst/trunk/tests/test_suite/files/case_sensitive.xsd new file mode 100644 index 000000000..afc0ee932 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive.xsd @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/case_sensitive2.wsdl b/wst/trunk/tests/test_suite/files/case_sensitive2.wsdl new file mode 100644 index 000000000..236196bde --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive2.wsdl @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/case_sensitive2.xsd b/wst/trunk/tests/test_suite/files/case_sensitive2.xsd new file mode 100644 index 000000000..a71ba8ce0 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive2.xsd @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/case_sensitive3.wsdl b/wst/trunk/tests/test_suite/files/case_sensitive3.wsdl new file mode 100644 index 000000000..e81134aba --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive3.wsdl @@ -0,0 +1,42 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/case_sensitive3.xsd b/wst/trunk/tests/test_suite/files/case_sensitive3.xsd new file mode 100644 index 000000000..8d3f6d4c0 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/case_sensitive3.xsd @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice.wsdl b/wst/trunk/tests/test_suite/files/complex_class_choice.wsdl new file mode 100644 index 000000000..1af0b38cc --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice.wsdl @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice.xsd b/wst/trunk/tests/test_suite/files/complex_class_choice.xsd new file mode 100644 index 000000000..b8cd98737 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice2.wsdl b/wst/trunk/tests/test_suite/files/complex_class_choice2.wsdl new file mode 100644 index 000000000..02626fabe --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice2.wsdl @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice2.xsd b/wst/trunk/tests/test_suite/files/complex_class_choice2.xsd new file mode 100644 index 000000000..a463caa50 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice2.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice3.wsdl b/wst/trunk/tests/test_suite/files/complex_class_choice3.wsdl new file mode 100644 index 000000000..917ab2fb6 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice3.wsdl @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice3.xsd b/wst/trunk/tests/test_suite/files/complex_class_choice3.xsd new file mode 100644 index 000000000..b12ec35cd --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice3.xsd @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice4.wsdl b/wst/trunk/tests/test_suite/files/complex_class_choice4.wsdl new file mode 100644 index 000000000..db260bb28 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice4.wsdl @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_choice4.xsd b/wst/trunk/tests/test_suite/files/complex_class_choice4.xsd new file mode 100644 index 000000000..100f3f785 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_choice4.xsd @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 3699c9ea3..8307930ff 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -28,6 +28,9 @@ type { TTest_CustomXsdParser } TTest_CustomXsdParser = class(TTestCase) + protected + function ParseDoc(const ADoc : string) : TwstPasTreeContainer;overload;virtual; + function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;overload;virtual;abstract; protected function LoadEmptySchema() : TwstPasTreeContainer;virtual;abstract; function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;virtual;abstract; @@ -42,6 +45,10 @@ type function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; @@ -69,6 +76,10 @@ type 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; + + function load_schema_case_sensitive() : TwstPasTreeContainer;virtual;abstract; + function load_schema_case_sensitive2() : TwstPasTreeContainer;virtual;abstract; + function load_schema_case_sensitive_import() : TwstPasTreeContainer;virtual;abstract; published procedure EmptySchema(); @@ -88,6 +99,10 @@ type procedure ComplexType_Class_sequence_open_type_anyAttribute(); procedure ComplexType_Class_all_open_type_anyAttribute(); procedure ComplexType_Class_FalseArray(); + procedure ComplexType_Class_Choice(); + procedure ComplexType_Class_Choice2(); + procedure ComplexType_Class_Choice3(); + procedure ComplexType_Class_Choice4(); procedure ComplexType_Record(); procedure ComplexType_Record_Embedded(); @@ -113,13 +128,17 @@ type procedure schema_include_fail_namespace(); procedure schema_include_circular1(); procedure schema_include_circular2(); + + procedure case_sensitive(); + procedure case_sensitive2(); + procedure case_sensitive_import(); end; { TTest_XsdParser } TTest_XsdParser = class(TTest_CustomXsdParser) - private - function ParseDoc(const ADoc : string) : TwstPasTreeContainer; + protected + function ParseDoc(const ADoc : string; const ACaseSensistive : Boolean) : TwstPasTreeContainer;override; protected function LoadEmptySchema() : TwstPasTreeContainer;override; @@ -135,6 +154,10 @@ type function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; @@ -162,13 +185,17 @@ type function load_schema_include_fail_namespace() : TwstPasTreeContainer;override; function load_schema_include_circular1() : TwstPasTreeContainer;override; function load_schema_include_circular2() : TwstPasTreeContainer;override; + + function load_schema_case_sensitive() : TwstPasTreeContainer;override; + function load_schema_case_sensitive2() : TwstPasTreeContainer;override; + function load_schema_case_sensitive_import() : TwstPasTreeContainer;override; end; { TTest_WsdlParser } TTest_WsdlParser = class(TTest_CustomXsdParser) private - function ParseDoc(const ADoc : string) : TwstPasTreeContainer; + function ParseDoc(const ADoc : string; const ACaseSensitive : Boolean) : TwstPasTreeContainer;override; protected function LoadEmptySchema() : TwstPasTreeContainer;override; @@ -184,6 +211,10 @@ type function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_OpenType() : TwstPasTreeContainer;override; function LoadComplexType_Class_FalseArray() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; @@ -210,7 +241,11 @@ type 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; + function load_schema_include_circular2() : TwstPasTreeContainer;override; + + function load_schema_case_sensitive() : TwstPasTreeContainer;override; + function load_schema_case_sensitive2() : TwstPasTreeContainer;override; + function load_schema_case_sensitive_import() : TwstPasTreeContainer;override; published procedure no_binding_style(); procedure signature_last(); @@ -299,6 +334,11 @@ end; { TTest_CustomXsdParser } +function TTest_CustomXsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; +begin + Result := ParseDoc(ADoc,False); +end; + procedure TTest_CustomXsdParser.EmptySchema(); var tr : TwstPasTreeContainer; @@ -995,6 +1035,240 @@ begin end; end; +procedure TTest_CustomXsdParser.ComplexType_Class_Choice(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Choice_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('complex_class_choice',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement('TSampleType1'); + CheckNotNull(elt,'TSampleType1'); + CheckEquals('TSampleType1',elt.Name); + CheckEquals('TSampleType1',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Choice2(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string); + var + prp : TPasProperty; + prpType : TPasArrayType; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckIs(prp.VarType,TPasArrayType); + prpType := TPasArrayType(prp.VarType); + CheckNotNull(prpType.ElType); + CheckEquals(ATypeName,tr.GetExternalName(prpType.ElType)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Choice2_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('complex_class_choice2',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + elt := tr.FindElement('TSampleType1'); + CheckNotNull(elt,'TSampleType1'); + CheckEquals('TSampleType1',elt.Name); + CheckEquals('TSampleType1',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty(x_intField,'int'); + CheckProperty(x_strField,'string'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Choice3(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Choice3_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('complex_class_choice3',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement('TSampleType1'); + CheckNotNull(elt,'TSampleType1'); + CheckEquals('TSampleType1',elt.Name); + CheckEquals('TSampleType1',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(4,prpLs.Count); + CheckProperty('intField1','int',ptField); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + CheckProperty('dateField','date',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Choice4(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Choice4_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('complex_class_choice4',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement('TSampleType1'); + CheckNotNull(elt,'TSampleType1'); + CheckEquals('TSampleType1',elt.Name); + CheckEquals('TSampleType1',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(4,prpLs.Count); + CheckProperty('intField1','int',ptField); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + CheckProperty('dateField','date',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + procedure TTest_CustomXsdParser.ComplexType_Record(); var tr : TwstPasTreeContainer; @@ -2164,9 +2438,278 @@ begin end; end; +procedure TTest_CustomXsdParser.case_sensitive(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := load_schema_case_sensitive(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('case_sensitive',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(4,ls.Count); + + elt := tr.FindElement('Date'); + CheckNotNull(elt,'Date'); + CheckEquals('Date',tr.GetExternalName(elt)); + CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'Date.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('String'); + CheckNotNull(elt,'String'); + CheckEquals('String',tr.GetExternalName(elt)); + CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'String.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('Boolean'); + CheckNotNull(elt,'Boolean'); + CheckEquals('Boolean',tr.GetExternalName(elt)); + CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'Boolean.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement(x_complexType_SampleClassType); + CheckNotNull(elt,x_complexType_SampleClassType); + CheckEquals(x_complexType_SampleClassType,elt.Name); + CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(8,prpLs.Count); + CheckProperty('dateField','date',ptField); + CheckProperty('localDateField','Date',ptField); + CheckProperty('booleanField','boolean',ptField); + CheckProperty('localBooleanField','Boolean',ptField); + CheckProperty('stringField','string',ptField); + CheckProperty('localStringField','String',ptField); + CheckProperty('dateAtt','date',ptAttribute); + CheckProperty('localDateAtt','Date',ptAttribute); + + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.case_sensitive2(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := load_schema_case_sensitive2(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals('case_sensitive2',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count); + + elt := tr.FindElement('SampleType'); + CheckNotNull(elt,'SampleType'); + CheckEquals('SampleType',tr.GetExternalName(elt)); + CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('SAMPLETYPE'); + CheckNotNull(elt,'SAMPLETYPE'); + CheckEquals('SAMPLETYPE',tr.GetExternalName(elt)); + CheckEquals(x_targetNamespace,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement(x_complexType_SampleClassType); + CheckNotNull(elt,x_complexType_SampleClassType); + CheckEquals(x_complexType_SampleClassType,elt.Name); + CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('Field1','SampleType',ptField); + CheckProperty('Field2','SAMPLETYPE',ptField); + + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.case_sensitive_import(); +const CONST_NS = 'urn:wst-test3'; +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := load_schema_case_sensitive_import(); + //----------------------------------------- + mdl := tr.FindModule('urn:wst-test'); + CheckNotNull(mdl); + CheckEquals('case_sensitive2',mdl.Name); + CheckEquals('urn:wst-test',tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count); + + elt := tr.FindElement('SampleType'); + CheckNotNull(elt,'SampleType'); + CheckEquals('SampleType',tr.GetExternalName(elt)); + CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'SampleType.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('SAMPLETYPE'); + CheckNotNull(elt,'SAMPLETYPE'); + CheckEquals('SAMPLETYPE',tr.GetExternalName(elt)); + CheckEquals('urn:wst-test',tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'SAMPLETYPE.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + //----------------------------------------- + mdl := tr.FindModule(CONST_NS); + CheckNotNull(mdl); + CheckEquals('case_sensitive3',mdl.Name); + CheckEquals(CONST_NS,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count); + + elt := tr.FindElement('TypeA'); + CheckNotNull(elt,'TypeA'); + CheckEquals('TypeA',tr.GetExternalName(elt)); + CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'TypeA.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('TYPEA'); + CheckNotNull(elt,'TYPEA'); + CheckEquals('TYPEA',tr.GetExternalName(elt)); + CheckEquals(CONST_NS,tr.GetNameSpace(elt as TPasType)); + CheckIs(elt,TPasAliasType); + CheckNotNull(TPasAliasType(elt).DestType,'TYPEA.DestType'); + CheckEquals('string',TPasAliasType(elt).DestType.Name); + + elt := tr.FindElement('CompoundType'); + CheckNotNull(elt,'CompoundType'); + CheckEquals('CompoundType',elt.Name); + CheckEquals('CompoundType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(4,prpLs.Count); + CheckProperty('f1','SampleType',ptField); + CheckProperty('f2','SAMPLETYPE',ptField); + CheckProperty('f3','TypeA',ptField); + CheckProperty('f4','TYPEA',ptField); + + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + { TTest_XsdParser } -function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; +function TTest_XsdParser.ParseDoc( + const ADoc: string; + const ACaseSensistive: Boolean +): TwstPasTreeContainer; var locDoc : TXMLDocument; prs : IXsdPaser; @@ -2177,6 +2720,7 @@ begin locDoc := LoadXmlFile(fileName); try Result := TwstPasTreeContainer.Create(); + Result.CaseSensitive := ACaseSensistive; CreateWstInterfaceSymbolTable(Result); prs := TXsdParser.Create(locDoc,Result,ADoc); prsCtx := prs as IParserContext; @@ -2337,6 +2881,21 @@ begin Result := ParseDoc('include_circular2'); end; +function TTest_XsdParser.load_schema_case_sensitive(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive',True); +end; + +function TTest_XsdParser.load_schema_case_sensitive2(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive2',True); +end; + +function TTest_XsdParser.load_schema_case_sensitive_import(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive3',True); +end; + function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer; begin Result := ParseDoc('class_widechar_property'); @@ -2352,9 +2911,32 @@ begin Result := ParseDoc('complex_class_false_array'); end; +function TTest_XsdParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice2'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice3'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice4'); +end; + { TTest_WsdlParser } -function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; +function TTest_WsdlParser.ParseDoc( + const ADoc: string; + const ACaseSensitive: Boolean +) : TwstPasTreeContainer; var locDoc : TXMLDocument; prs : IParser; @@ -2365,6 +2947,7 @@ begin locDoc := LoadXmlFile(fileName); try Result := TwstPasTreeContainer.Create(); + Result.CaseSensitive := ACaseSensitive; CreateWstInterfaceSymbolTable(Result); prs := TWsdlParser.Create(locDoc,Result); prsCtx := prs as IParserContext; @@ -2420,6 +3003,26 @@ begin Result := ParseDoc('complex_class_false_array'); end; +function TTest_WsdlParser.LoadComplexType_Class_Choice_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Choice2_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice2'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Choice3_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice3'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Choice4_Schema(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_choice4'); +end; + function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_record); @@ -3104,6 +3707,21 @@ begin Result := ParseDoc('include_circular2'); end; +function TTest_WsdlParser.load_schema_case_sensitive(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive',True); +end; + +function TTest_WsdlParser.load_schema_case_sensitive2(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive2',True); +end; + +function TTest_WsdlParser.load_schema_case_sensitive_import(): TwstPasTreeContainer; +begin + Result := ParseDoc('case_sensitive3',True); +end; + initialization RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite); diff --git a/wst/trunk/tests/test_suite/testmetadata_unit.pas b/wst/trunk/tests/test_suite/testmetadata_unit.pas index 4b79b4694..9310dbf94 100644 --- a/wst/trunk/tests/test_suite/testmetadata_unit.pas +++ b/wst/trunk/tests/test_suite/testmetadata_unit.pas @@ -99,7 +99,7 @@ begin sct.Declarations.Add(inft); sct.Types.Add(inft); CreateProc('void_operation_proc',inft,Result); - CreateFunc('void_operation_func','Integer',inft,Result); + CreateFunc('void_operation_func','integer',inft,Result); inft := TPasClassType(Result.CreateElement(TPasClassType,'service_2',sct,visDefault,'',0)); inft.ObjKind := okInterface; @@ -107,11 +107,11 @@ begin sct.Types.Add(inft); locProc := CreateProc('dis_proc',inft,Result); CreateParam('d','double',argDefault,locProc,Result); - CreateParam('i','Integer',argConst,locProc,Result); + CreateParam('i','integer',argConst,locProc,Result); CreateParam('s','string',argOut,locProc,Result); locProc := CreateFunc('sid_func','double',inft,Result); CreateParam('s','string',argConst,locProc,Result); - CreateParam('i','Integer',argVar,locProc,Result); + CreateParam('i','integer',argVar,locProc,Result); end; procedure PrintWSDL(ARep : PServiceRepository); diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index 49f8abaca..3e448b891 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -89,7 +89,7 @@ type function AddNameSpace(const AValue: string; ANameSpaceList : TStrings): TStrings; procedure BuildNameSpaceList(AAttCursor : IObjectCursor; ANameSpaceList : TStrings); procedure ExplodeQName(const AQName : string; out ALocalName, ANameSpace : string) ; - + function wst_findCustomAttribute( AWsdlShortNames : TStrings; ANode : TDOMNode; diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 2df03cc75..04fcb63ef 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -33,6 +33,8 @@ const sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; + CASE_SENSITIVE_DEFAULT = True; + {$IF not Declared(TInterfaceSection) } type TInterfaceSection = TPasSection; @@ -165,7 +167,7 @@ type function IsInitNeed(AType: TPasType): Boolean; function IsOfType(AType: TPasType; AClass: TClass): Boolean; - property CaseSensitive : Boolean read FCaseSensitive write FCaseSensitive; + property CaseSensitive : Boolean read FCaseSensitive write FCaseSensitive default CASE_SENSITIVE_DEFAULT; end; TPasNativeModule = class(TPasModule) @@ -632,6 +634,7 @@ end; constructor TwstPasTreeContainer.Create(); begin + FCaseSensitive := CASE_SENSITIVE_DEFAULT; FPackage := TPasPackage.Create('sample',nil); FBindingList := TObjectList.Create(True); FProperties := TPropertyHolder.Create(); diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index baaa5efcc..42895f83c 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -124,6 +124,7 @@ type private //helper routines function ExtractElementCursor( + AParentNode : TDOMNode; out AAttCursor : IObjectCursor; out AAnyNode, AAnyAttNode : TDOMNode ):IObjectCursor; @@ -424,6 +425,7 @@ end; { TComplexTypeParser } function TComplexTypeParser.ExtractElementCursor( + AParentNode : TDOMNode; out AAttCursor : IObjectCursor; out AAnyNode, AAnyAttNode : TDOMNode ) : IObjectCursor; @@ -457,11 +459,18 @@ var var tmpCursor : IObjectCursor; tmpNode : TDOMNode; + tmpFilter : IObjectFilter; begin ARes := nil; + tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer); + tmpFilter := TAggregatedFilter.Create( + tmpFilter, + ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer), + fcOr + ) as IObjectFilter; tmpCursor := CreateCursorOn( frstCrsr.Clone() as IObjectCursor, - ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer) + tmpFilter ); tmpCursor.Reset(); Result := tmpCursor.MoveNext(); @@ -469,9 +478,15 @@ var FSequenceType := stElement; tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; if tmpNode.HasChildNodes() then begin + tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer); + tmpFilter := TAggregatedFilter.Create( + tmpFilter, + ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer), + fcOr + ) as IObjectFilter; tmpCursor := CreateCursorOn( CreateChildrenCursor(tmpNode,cetRttiNode), - ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer) + tmpFilter ); ARes := tmpCursor; tmpCursor := CreateCursorOn( @@ -493,10 +508,13 @@ begin AAttCursor := nil; AAnyNode := nil; AAnyAttNode := nil; - case FDerivationMode of - dmNone : parentNode := FContentNode; - dmRestriction, - dmExtension : parentNode := FDerivationNode; + parentNode := AParentNode; + if (parentNode = nil) then begin + case FDerivationMode of + dmNone : parentNode := FContentNode; + dmRestriction, + dmExtension : parentNode := FDerivationNode; + end; end; if parentNode.HasChildNodes() then begin; AAttCursor := CreateCursorOn( @@ -805,6 +823,14 @@ begin end; end; +type + TOccurrenceRec = record + Valid : Boolean; + MinOccurs : Integer; + MaxOccurs : Integer; + Unboundded : Boolean; + end; + function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType; var classDef : TPasClassType; @@ -818,7 +844,58 @@ var Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer)); end; - procedure ParseElement(AElement : TDOMNode); + procedure ExtractOccurences( + AItemName : string; + AAttCursor : IObjectCursor; + var AMinOccurs, + AMaxOccurs : Integer; + var AMaxUnboundded : Boolean + ); + var + locAttCursor, locPartCursor : IObjectCursor; + locMin, locMax : Integer; + locMaxOccurUnbounded : Boolean; + locStrBuffer : string; + begin + if (AAttCursor = nil) then begin + AMinOccurs := 1; + AMaxOccurs := 1; + AMaxUnboundded := False; + exit; + end; + + locMin := 1; + locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMin) then + raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]); + if ( locMin < 0 ) then + raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,AItemName]); + end; + + locMax := 1; + locMaxOccurUnbounded := False; + locPartCursor := CreateCursorOn(AAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if AnsiSameText(locStrBuffer,s_unbounded) then begin + locMaxOccurUnbounded := True; + end else begin + if not TryStrToInt(locStrBuffer,locMax) then + raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]); + if ( locMin < 0 ) then + raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,AItemName]); + end; + end; + + AMinOccurs := locMin; + AMaxOccurs := locMax; + AMaxUnboundded := locMaxOccurUnbounded; + end; + + procedure ParseElement(AElement : TDOMNode; const ABoundInfos : TOccurrenceRec); var locAttCursor, locPartCursor : IObjectCursor; locName, locTypeName, locTypeInternalName : string; @@ -939,14 +1016,18 @@ var locMinOccur := 0; end; end else begin - locMinOccur := 1; - locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); - locPartCursor.Reset(); - if locPartCursor.MoveNext() then begin - if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then - raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); - if ( locMinOccur < 0 ) then - raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); + if ABoundInfos.Valid then begin + locMinOccur := ABoundInfos.MinOccurs; + end else begin + locMinOccur := 1; + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then + raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); + if ( locMinOccur < 0 ) then + raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]); + end; end; end; locProp.ReadAccessorName := 'F' + locProp.Name; @@ -959,19 +1040,24 @@ var locProp.StoredAccessorName := 'True'; end; - locMaxOccur := 1; - locMaxOccurUnbounded := False; - locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer)); - locPartCursor.Reset(); - if locPartCursor.MoveNext() then begin - locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; - if AnsiSameText(locStrBuffer,s_unbounded) then begin - locMaxOccurUnbounded := True; - end else begin - if not TryStrToInt(locStrBuffer,locMaxOccur) then - raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); - if ( locMinOccur < 0 ) then - raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); + if ABoundInfos.Valid then begin + locMaxOccur := ABoundInfos.MaxOccurs; + locMaxOccurUnbounded := ABoundInfos.Unboundded; + end else begin + locMaxOccur := 1; + locMaxOccurUnbounded := False; + locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer)); + locPartCursor.Reset(); + if locPartCursor.MoveNext() then begin + locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; + if AnsiSameText(locStrBuffer,s_unbounded) then begin + locMaxOccurUnbounded := True; + end else begin + if not TryStrToInt(locStrBuffer,locMaxOccur) then + raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); + if ( locMinOccur < 0 ) then + raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]); + end; end; end; isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 ); @@ -995,18 +1081,56 @@ var Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer)); end; - procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor); + procedure ParseElementsAndAttributes( + AEltCrs, + AEltAttCrs : IObjectCursor; + ABoundInfos : TOccurrenceRec + ); + + function ExtractElement(ANode : TDOMNode) : IObjectCursor; + var + tmpFilter : IObjectFilter; + begin + tmpFilter := ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer); + tmpFilter := TAggregatedFilter.Create( + tmpFilter, + ParseFilter(CreateQualifiedNameFilterStr(s_choice,Context.GetXsShortNames()),TDOMNodeRttiExposer), + fcOr + ) as IObjectFilter; + Result := CreateCursorOn( + CreateChildrenCursor(ANode,cetRttiNode), + tmpFilter + ); + end; + + var + locNode, locAnyNode, locAnyAttNode : TDOMNode; + locNS, locLN : string; + locEltCrs, locEltAttCrs : IObjectCursor; + locBoundInfos : TOccurrenceRec; begin if Assigned(AEltCrs) then begin AEltCrs.Reset(); while AEltCrs.MoveNext() do begin - ParseElement((AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + locNode := (AEltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + ExplodeQName(locNode.NodeName,locLN,locNS); + if (locLN = s_choice) then begin + locEltCrs := ExtractElement(locNode); + if (locEltCrs <> nil) then begin + ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded); + locBoundInfos.MinOccurs := 0; + locBoundInfos.Valid := True; + ParseElementsAndAttributes(locEltCrs,locEltAttCrs,locBoundInfos); + end; + end else begin + ParseElement(locNode,ABoundInfos); + end; end; end; if Assigned(AEltAttCrs) then begin AEltAttCrs.Reset(); while AEltAttCrs.MoveNext() do begin - ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject); + ParseElement((AEltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject,ABoundInfos); end; end; end; @@ -1067,9 +1191,11 @@ var locStrBuffer : string; locAnyNode, locAnyAttNode : TDOMNode; locDefaultAncestorUsed : Boolean; + locBoundInfos : TOccurrenceRec; + locTempNode : TDOMNode; begin ExtractBaseType(); - eltCrs := ExtractElementCursor(eltAttCrs,locAnyNode,locAnyAttNode); + eltCrs := ExtractElementCursor(nil,eltAttCrs,locAnyNode,locAnyAttNode); internalName := ExtractIdentifier(ATypeName); hasInternalName := IsReservedKeyWord(internalName) or @@ -1110,7 +1236,24 @@ begin classDef.AncestorType.AddRef(); if Assigned(eltCrs) or Assigned(eltAttCrs) then begin isArrayDef := False; - ParseElementsAndAttributes(eltCrs,eltAttCrs); + FillChar(locBoundInfos,SizeOf(locBoundInfos),#0); + if (eltCrs <> nil) then begin + eltCrs.Reset(); + if eltCrs.MoveNext() then begin + locTempNode := (eltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + locTempNode := locTempNode.ParentNode; + if (ExtractNameFromQName(locTempNode.NodeName) = s_choice) then begin + ExtractOccurences( + s_choice, + CreateAttributesCursor(locTempNode,cetRttiNode), + locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded + ); + locBoundInfos.MinOccurs := 0; + locBoundInfos.Valid := True; + end; + end; + end; + ParseElementsAndAttributes(eltCrs,eltAttCrs,locBoundInfos); if ( arrayItems.GetCount() > 0 ) then begin if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 2564cd0b2..7e16562bb 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -35,6 +35,7 @@ const s_base : WideString = 'base'; s_binding : WideString = 'binding'; s_body : WideString = 'body'; + s_choice = 'choice'; s_complexContent : WideString = 'complexContent'; s_complexType : WideString = 'complexType'; s_customAttributes : WideString = 'customAttributes';