diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas new file mode 100644 index 000000000..f54f488c3 --- /dev/null +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -0,0 +1,207 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007, 2008 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit test_generators; + +interface +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testutils, testregistry, DOM, XmlRead, XmlWrite, wst_fpc_xml, +{$ELSE} + TestFrameWork, xmldom, wst_delphi_xml, +{$ENDIF} + pastree, pascal_parser_intf, xsd_generator; + +type + + TPropertyType = ( ptField, ptAttribute ); + + TTest_CustomXsdGenerator = class(TTestCase) + protected + function CreateGenerator(const ADoc : TXMLDocument) : IXsdGenerator;virtual;abstract; + function LoadXmlFromFilesList(const AFileName : string) : TXMLDocument; + published + procedure class_properties_default(); + procedure class_properties_extended_metadata(); + end; + + TTest_XsdGenerator = class(TTest_CustomXsdGenerator) + protected + function CreateGenerator(const ADoc : TXMLDocument) : IXsdGenerator;override; + end; + +implementation + +uses test_suite_utils; + +{ TTest_CustomXsdGenerator } + +procedure TTest_CustomXsdGenerator.class_properties_default(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + procedure AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType + ); + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.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.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'class_properties_default',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TClassSampleType',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('intField','integer','1210',ptField); + AddProperty('strField','string','azerty',ptField); + AddProperty('floatField','float','1234',ptField); + AddProperty('strAtt','string','attribute azerty',ptAttribute); + AddProperty('intAtt','integer','789',ptAttribute); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + WriteXMLFile(locDoc,'.\class_properties_default.xsd'); + locExistDoc := LoadXmlFromFilesList('class_properties_default.xsd'); + Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdGenerator.class_properties_extended_metadata(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + function AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType; + const AExtMetadataName, + AExtMetadataValue : string + ) : TPasProperty; + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.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.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + if ( Length(AExtMetadataName) > 0 ) then + tr.Properties.SetValue(p,AExtMetadataName,AExtMetadataValue); + Result := p; + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; + p : TPasProperty; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'urn:wst-test',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TClassSampleType',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + p := AddProperty('intField','integer','',ptField,'uri-4#a','1210'); + tr.Properties.SetValue(p,'uri-4#b','uri-5#xx'); + AddProperty('strField','string','azerty',ptField,'uri-4#a','http://www.w3.org/2001/XMLSchema#int'); + AddProperty('floatField','float','',ptField,'',''); + AddProperty('strAtt','string','attribute azerty',ptAttribute,'uri-4#a','optional'); + AddProperty('intAtt','integer','',ptAttribute,'',''); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + WriteXMLFile(locDoc,'.\class_properties_extended_metadata.xsd'); + locExistDoc := LoadXmlFromFilesList('class_properties_extended_metadata.xsd'); + Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + +function TTest_CustomXsdGenerator.LoadXmlFromFilesList(const AFileName: string): TXMLDocument; +var + locFileName : string; +begin +{$IFDEF FPC} + locFileName := Format('.%sfiles%s%s',[PathDelim,PathDelim,AFileName]); +{$ENDIF} +{$IFDEF DELPHI} + locFileName := Format('..%sfiles%s%s',[PathDelim,PathDelim,AFileName]); +{$ENDIF} + ReadXMLFile(Result,locFileName); +end; + +{ TTest_XsdGenerator } + +function TTest_XsdGenerator.CreateGenerator(const ADoc: TXMLDocument): IXsdGenerator; +begin + Result := TXsdGenerator.Create(ADoc) as IXsdGenerator; +end; + +initialization + RegisterTest('XSD generator',TTest_XsdGenerator.Suite); + +end. diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 2c7d80bf0..f83924362 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -35,6 +35,8 @@ type function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_default_values() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;virtual;abstract; @@ -51,6 +53,8 @@ type procedure SimpleType_AliasToNativeType(); procedure ComplexType_Class(); + procedure ComplexType_Class_default_values(); + procedure ComplexType_Class_properties_extended_metadata(); procedure ComplexType_Class_Embedded(); procedure ComplexType_Class_Extend_Simple_Schema(); @@ -74,16 +78,18 @@ type function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_default_values() : TwstPasTreeContainer;override; + function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;override; function LoadComplexType_Class_Embedded_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Extend_Simple_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; - + function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; end; - + { TTest_WsdlParser } TTest_WsdlParser = class(TTest_CustomXsdParser) @@ -93,6 +99,8 @@ type function LoadEmptySchema() : TwstPasTreeContainer;override; function LoadSimpleType_Enum_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_default_values() : TwstPasTreeContainer;override; + function LoadComplexType_Class_properties_extended_metadata() : TwstPasTreeContainer;override; function LoadSimpleType_Enum_Embedded_Schema() : TwstPasTreeContainer;override; function LoadSimpleType_AliasToNativeType_Schema() : TwstPasTreeContainer;override; @@ -128,6 +136,8 @@ const x_complexType_array_sequence = 'complex_array_sequence'; x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded'; x_complexType_class = 'complex_class'; + x_complexType_class_default = 'complex_class_default'; + x_complexType_class_properties_extended_metadata = 'class_properties_extended_metadata'; x_complexType_extend_simple = 'complex_class_extend_simple'; x_complexType_class_embedded = 'complex_class_embedded'; x_complexType_record = 'complex_record'; @@ -312,7 +322,7 @@ procedure TTest_CustomXsdParser.ComplexType_Class(); var tr : TwstPasTreeContainer; clsType : TPasClassType; - + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); var prp : TPasProperty; @@ -325,7 +335,7 @@ var CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); end; - + var mdl : TPasModule; ls : TList; @@ -972,6 +982,144 @@ begin end; end; +procedure TTest_CustomXsdParser.ComplexType_Class_default_values; +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty( + const AName, + ATypeName : string; + const AFieldType : TPropertyType; + const ADefault : string + ); + 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)); + CheckEquals(ADefault,prp.DefaultValue,'default'); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_default_values(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_class_default,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + 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(x_intField,'int',ptField,'1210'); + CheckProperty(x_strField,'string',ptField,'azerty'); + CheckProperty(x_floatField,'float',ptField,'1234'); + CheckProperty(x_byteField,'byte',ptField,'23'); + CheckProperty(x_charField,'char',ptField,'i'); + CheckProperty(x_longField,'long',ptField,'567'); + CheckProperty(x_strAtt,'string',ptAttribute,'attribute azerty'); + CheckProperty(x_intAtt,'int',ptAttribute,'789'); + finally + FreeAndNil(prpLs); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_properties_extended_metadata(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty( + const AName, + ATypeName : string; + const AFieldType : TPropertyType; + const ADefault : string; + const AExtMetaDataNameSpace, + AExtMetaDataLocalName, + AExtMetaDataValue : string + ); + var + prp : TPasProperty; + locExtMeta : string; + 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)); + CheckEquals(ADefault,prp.DefaultValue,'default'); + locExtMeta := Format('%s#%s',[AExtMetaDataNameSpace,AExtMetaDataLocalName]); + if not IsStrEmpty(locExtMeta) then + CheckEquals(AExtMetaDataValue, tr.Properties.GetValue(prp,locExtMeta), 'extended metadata'); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; +begin + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_properties_extended_metadata(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_class_properties_extended_metadata,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + 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(5,prpLs.Count); + CheckProperty(x_intField,'int',ptField,'', 'uri-4','a','1210'); + CheckProperty(x_intField,'int',ptField,'', 'uri-4','b','uri-5#xx'); + CheckProperty(x_strField,'string',ptField,'azerty', 'uri-4','a', 'http://www.w3.org/2001/XMLSchema#int'); + CheckProperty(x_strAtt,'string',ptAttribute,'attribute azerty', 'uri-4','a', 'optional'); + CheckProperty(x_intAtt,'int',ptAttribute,'', '', '', ''); + finally + FreeAndNil(prpLs); + end; +end; + { TTest_XsdParser } function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -1050,6 +1198,16 @@ begin Result := ParseDoc(x_complexType_array_sequence_embedded); end; +function TTest_XsdParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_default); +end; + +function TTest_XsdParser.LoadComplexType_Class_properties_extended_metadata(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_properties_extended_metadata); +end; + { TTest_WsdlParser } function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -1147,6 +1305,16 @@ begin end; end; +function TTest_WsdlParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_default); +end; + +function TTest_WsdlParser.LoadComplexType_Class_properties_extended_metadata(): TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_class_properties_extended_metadata); +end; + initialization RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite);