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

Default values of class's properties

Browse Source 
Extended metadata of class's properties

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@466 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-06-06 15:04:35 +00:00
parent aa9c003b61
commit 473b688be7
2 changed files with 379 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

207
wst/trunk/tests/test_suite/test_generators.pas Normal file
View File

@ -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.

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

@ -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);