Default values of class's properties

Extended metadata of class's properties

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@466 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.

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,6 +78,8 @@ 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;
 
@@ -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';
@@ -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);