Changed: collection behaviour (not yet finished - waiting for named Format implementation)

2024-11-21 13:43:49 +00:00 · 2008-03-14 15:35:07 +00:00 · 2008-03-14 15:35:07 +00:00 · 478551716c
commit 478551716c
parent 3df5f92709
10 changed files with 217 additions and 67 deletions
--- a/types_expected.xml
+++ b/types_expected.xml
@ -5,15 +5,15 @@
 			<Name>01. Basic simple and complex types</Name>
 			<Items>
 				<Item>
-					<ItemType>Interface</ItemType>
 					<Name>TestElement</Name>
+					<ItemType>Interface</ItemType>
 					<Interface>
 						<InterfaceType>Interface</InterfaceType>
 					</Interface>
 				</Item>
 				<Item>
-					<ItemType>Interface</ItemType>
 					<Name>TestComplexType</Name>
+					<ItemType>Interface</ItemType>
 					<Interface>
 						<InterfaceType>ComplexType</InterfaceType>
 					</Interface>
--- a/Collection.xsd
+++ b/Collection.xsd
@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
+	<xs:element name="Root">
+		<xs:complexType>
+			<xs:sequence>
+				<xs:element name="ComplexParts">
+					<xs:complexType>
+						<xs:sequence>
+							<xs:element name="ComplexPart" minOccurs="0" maxOccurs="unbounded">
+								<xs:complexType>
+									<xs:sequence>
+										<xs:element name="ComplexValue" type="xs:string"/>
+									</xs:sequence>
+								</xs:complexType>
+							</xs:element>
+						</xs:sequence>
+					</xs:complexType>
+				</xs:element>
+				<xs:element name="SimpleParts">
+					<xs:complexType>
+						<xs:sequence>
+							<xs:element name="SimpleValue" type="xs:string" minOccurs="0" maxOccurs="unbounded"/>
+						</xs:sequence>
+					</xs:complexType>
+				</xs:element>
+			</xs:sequence>
+		</xs:complexType>
+	</xs:element>
+</xs:schema>
--- a/Collection_expected.xml
+++ b/Collection_expected.xml
@ -0,0 +1,59 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<DataBindingResult xsi:noNamespaceSchemaLocation="F:\Archive\2007\XMLDataBinding\Tests\XSD\DataBindingResult.xsd" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
+	<Schemas>
+		<Schema>
+			<Name>02. Collection</Name>
+			<Items>
+				<Item>
+					<Name>Root</Name>
+					<ItemType>Interface</ItemType>
+					<Interface>
+						<InterfaceType>Interface</InterfaceType>
+					</Interface>
+				</Item>
+
+        <!-- TODO: Parts moet worden gecollapsed naar een ItemType Collection -->
+				<Item>
+					<Name>ComplexParts</Name>
+					<ItemType>Interface</ItemType>
+					<Interface>
+						<InterfaceType>Interface</InterfaceType>
+					</Interface>
+				</Item>
+
+				<Item>
+					<ItemType>Collection</ItemType>
+					<Name>ComplexPartList</Name>
+          <Collection>
+            <ItemName>ComplexPart</ItemName>
+          </Collection>
+				</Item>
+
+				<Item>
+					<Name>ComplexPart</Name>
+					<ItemType>Interface</ItemType>
+					<Interface>
+						<InterfaceType>Interface</InterfaceType>
+					</Interface>
+				</Item>
+
+
+        <Item>
+          <Name>SimpleParts</Name>
+          <ItemType>Interface</ItemType>
+          <Interface>
+            <InterfaceType>Interface</InterfaceType>
+          </Interface>
+        </Item>
+
+				<Item>
+					<ItemType>Collection</ItemType>
+					<Name>SimpleValueList</Name>
+          <Collection>
+            <ItemName>SimpleValue</ItemName>
+          </Collection>
+				</Item>
+      </Items>
+		</Schema>
+	</Schemas>
+</DataBindingResult>
--- a/Tests/Source/ObjectMappingTests.pas
+++ b/Tests/Source/ObjectMappingTests.pas
@ -23,6 +23,7 @@ type

    procedure CompareSchemas(ATestResult: TTestResult; AGenerator: TTestXMLDataBindingGenerator; AResult: IXMLDataBindingResult);
    procedure CompareItems(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AResultSchema: IXMLSchema);
+    procedure CompareCollection(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AGeneratorItem: TXMLDataBindingCollection; AResultItem: IXMLItem);

    property FileName:  String  read FFileName;
  public
@ -134,21 +135,33 @@ end;

 procedure TObjectMappingTests.CompareItems(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AResultSchema: IXMLSchema);

-  function FindItem(const AName: String): TXMLDataBindingItem;
+  function FindItem(const AResultItem: IXMLItem): TXMLDataBindingItem;
  var
+    itemType:   TXMLDataBindingItemType;
    itemIndex:  Integer;
+    item:       TXMLDataBindingItem;

  begin
    Result    := nil;
+    itemType  := itInterface;
+
+    if AResultItem.ItemType = 'Collection' then
+      itemType := itCollection
+    else if AResultItem.ItemType = 'Enumeration' then
+      itemType := itEnumeration;

    for itemIndex := 0 to Pred(AGeneratorSchema.ItemCount) do
-      if (AGeneratorSchema.Items[itemIndex].Name = AName) and
-         (AGeneratorSchema.Items[itemIndex].ItemType <> itForward) then
    begin
-        Result  := AGeneratorSchema.Items[itemIndex];
+      item  := AGeneratorSchema.Items[itemIndex];
+
+      if (item.ItemType = itemType) and
+         (item.Name = AResultItem.Name) then
+      begin
+        Result  := item;
        break;
      end;
    end;
+  end;


 var
@ -160,22 +173,26 @@ var
 begin
  handled := TObjectList.Create(False);
  try
-    { Iterate expected schemas }
+    { Iterate expected items }
    for itemIndex := 0 to Pred(AResultSchema.Items.Count) do
    begin
      resultItem  := AResultSchema.Items[itemIndex];
-      bindingItem := FindItem(resultItem.Name);
+      bindingItem := FindItem(resultItem);

      if Assigned(bindingItem) then
      begin
        handled.Add(bindingItem);
-//        CompareItems(ATestResult, bindingSchema, resultSchema);
+
+        case bindingItem.ItemType of
+//          itInterface:  CompareProperties;
+          itCollection: CompareCollection(ATestResult, AGeneratorSchema, TXMLDataBindingCollection(bindingItem), resultItem);
+        end;
      end else
-        ATestResult.AddFailure(Self, nil, Format('Schema "%s": item "%s" expected',
+        ATestResult.AddFailure(Self, nil, Format('Item "%s.%s" expected',
                               [AGeneratorSchema.SchemaName, resultItem.Name]));
    end;

-    { Find unexpected schemas }
+    { Find unexpected items }
    for itemIndex := 0 to Pred(AGeneratorSchema.ItemCount) do
    begin
      bindingItem := AGeneratorSchema.Items[itemIndex];
@ -184,7 +201,7 @@ begin
      begin
        if handled.IndexOf(bindingItem) = -1 then
        begin
-          ATestResult.AddFailure(Self, nil, Format('Schema "%s": item "%s" not expected',
+          ATestResult.AddFailure(Self, nil, Format('Item "%s.%s" not expected',
                                                   [AGeneratorSchema.SchemaName,
                                                    AGeneratorSchema.Items[itemIndex].Name]));
        end;
@ -196,6 +213,23 @@ begin
 end;


+procedure TObjectMappingTests.CompareCollection(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AGeneratorItem: TXMLDataBindingCollection; AResultItem: IXMLItem);
+begin
+  if Assigned(AGeneratorItem.CollectionItem) then
+  begin
+    if AGeneratorItem.CollectionItem.Name <> AResultItem.Collection.ItemName then
+      ATestResult.AddFailure(Self, nil, Format('Item "%s.%s": collection item "%s" expected but "%s" found',
+                                               [AGeneratorSchema.SchemaName,
+                                                AGeneratorItem.Name,
+                                                AResultItem.Collection.ItemName,
+                                                AGeneratorItem.CollectionItem.Name]));
+  end else
+    ATestResult.AddFailure(Self, nil, Format('Item "%s.%s": collection item not Assigned',
+                                             [AGeneratorSchema.SchemaName,
+                                              AGeneratorItem.Name]));
+end;
+
+
 { TTestXMLDataBindingGenerator }
 procedure TTestXMLDataBindingGenerator.GenerateDataBinding();
 begin
--- a/Tests/X2XMLDataBindingTests.cfg
+++ b/Tests/X2XMLDataBindingTests.cfg
@ -33,9 +33,9 @@
 -$M16384,1048576
 -K$00400000
 -E"..\"
-N0"..\Lib"
-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
+-N"..\Lib"
+-LE"c:\program files\borland\delphi7\Projects\Bpl"
+-LN"c:\program files\borland\delphi7\Projects\Bpl"
 -w-UNSAFE_TYPE
 -w-UNSAFE_CODE
 -w-UNSAFE_CAST
--- a/Tests/X2XMLDataBindingTests.dof
+++ b/Tests/X2XMLDataBindingTests.dof
@ -140,9 +140,5 @@ C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Pro
 Count=1
 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 [HistoryLists\hlUnitOutputDirectory]
-Count=2
-Item0=..\Lib
-Item1=Lib
-[HistoryLists\hlOutputDirectorry]
 Count=1
-Item0=..\
+Item0=Lib
--- a/Tests/XSD/DataBindingResult.xsd
+++ b/Tests/XSD/DataBindingResult.xsd
@ -31,8 +31,8 @@
 	</xs:complexType>
 	<xs:complexType name="Item">
 		<xs:sequence>
-			<xs:element ref="ItemType"/>
 			<xs:element name="Name" type="xs:string"/>
+			<xs:element ref="ItemType"/>
 			<xs:choice>
 				<xs:element name="Interface">
 					<xs:complexType>
--- a/Units/DelphiXMLDataBindingGenerator.pas
+++ b/Units/DelphiXMLDataBindingGenerator.pas
@ -295,9 +295,6 @@ begin
  Result := DelphiSafeName(inherited TranslateItemName(AItem));

  case AItem.ItemType of
-    itCollection:
-      Result := Result + 'List';
-      
    itEnumerationMember:
      Result := TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName + '_' + Result;
  end;
@ -945,11 +942,14 @@ end;


 procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
+var
+  dataTypeName: string;
+  

  procedure WriteMethodInterface(const AFunction: String);
  begin
    AStream.WriteLnFmt('    function ' + AFunction + ': %1:s%0:s;',
-                       [AItem.CollectionItem.TranslatedName,
+                       [dataTypeName,
                        PrefixInterface]);
  end;

@ -958,13 +958,13 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream
  begin
    AStream.WriteLnFmt('function %3:s%0:s.' + AFunction + ': %2:s%1:s;',
                       [AItem.TranslatedName,
-                        AItem.CollectionItem.TranslatedName,
+                        dataTypeName,
                        PrefixInterface,
                        PrefixClass]);
    AStream.WriteLn('begin');

    AStream.WriteLnFmt(AImplementation,
-                       [AItem.CollectionItem.TranslatedName,
+                       [dataTypeName,
                        PrefixInterface]);

    AStream.WriteLn('end;');
@ -994,7 +994,7 @@ begin

        AStream.WriteLnFmt('  RegisterChildNode(''%0:s'', %2:s%1:s);',
                           [AItem.CollectionItem.Name,
-                            AItem.CollectionItem.TranslatedName,
+                            dataTypeName,
                            PrefixClass]);

        AStream.WriteLn();
@ -1002,7 +1002,7 @@ begin
                           [AItem.CollectionItem.Name]);
                           
        AStream.WriteLnFmt('  ItemInterface := %1:s%0:s;',
-                           [AItem.CollectionItem.TranslatedName,
+                           [dataTypeName,
                            PrefixInterface]);

        AStream.WriteLn();
@ -1026,7 +1026,7 @@ begin
      begin
        AStream.WriteLn;
        AStream.WriteLnFmt('    property %0:s[Index: Integer]: %1:s%0:s read Get_%0:s; default;',
-                               [AItem.CollectionItem.TranslatedName,
+                               [dataTypeName,
                                PrefixInterface]);
      end;

--- a/Units/XMLDataBindingGenerator.pas
+++ b/Units/XMLDataBindingGenerator.pas
@ -64,6 +64,7 @@ type
    function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration;

    procedure ResolveSchema(ASchema: TXMLDataBindingSchema);
+    procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem);
    procedure ResolveNameConflicts();

    procedure TranslateSchema(ASchema: TXMLDataBindingSchema);
@ -176,13 +177,13 @@ type

  TXMLDataBindingCollection = class(TXMLDataBindingItem)
  private
-    FCollectionItem:  TXMLDataBindingInterface;
+    FCollectionItem:  TXMLDataBindingProperty;
+
+    procedure SetCollectionItem(const Value: TXMLDataBindingProperty);
  protected
    function GetItemType(): TXMLDataBindingItemType; override;
  public
-    constructor Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String);
-
-    property CollectionItem:  TXMLDataBindingInterface  read FCollectionItem;
+    property CollectionItem:  TXMLDataBindingProperty read FCollectionItem;
  end;


@ -286,6 +287,7 @@ uses

 const
  MaxOccursUnbounded  = 'unbounded';
+  CollectionPostfix   = 'List';



@ -595,6 +597,7 @@ begin
      end;


+      if Assigned(interfaceObject) then
        for elementIndex := 0 to Pred(AElement.ChildElements.Count) do
          ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject);
    end;
@ -622,7 +625,7 @@ begin

      if not Assigned(collectionObject) then
      begin
-        collectionObject  := TXMLDataBindingCollection.Create(AELement, AInterface, AElement.Name);
+        collectionObject  := TXMLDataBindingCollection.Create(AElement, AElement.Name + CollectionPostfix);
        ASchema.AddItem(collectionObject);
      end;
    end;
@ -630,8 +633,23 @@ begin


  propertyType := ProcessElement(ASchema, AElement);
+
  if Assigned(collectionObject) then
+  begin
+    { Create intermediate object for collections }
+    if Assigned(propertyType) then
+      propertyItem  := TXMLDataBindingItemProperty.Create(AElement,
+                                                          AElement.Name,
+                                                          propertyType)
+    else
+      propertyItem  := TXMLDataBindingSimpleProperty.Create(AElement,
+                                                            AElement.Name,
+                                                            AElement.DataType);
+
+
+    collectionObject.SetCollectionItem(propertyItem);
    propertyType := collectionObject;
+  end;


  if Assigned(AInterface) then
@ -732,9 +750,16 @@ end;


 procedure TXMLDataBindingGenerator.FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
+var
+  collection: TXMLDataBindingCollection;
+
 begin
-  AAbort  := (AItem.ItemType = itCollection) and
-             (AItem.Name = PChar(AData));
+  if AItem.ItemType = itCollection then
+  begin
+    collection  := TXMLDataBindingCollection(AItem);
+    AAbort      := Assigned(collection.CollectionItem) and
+                   (collection.CollectionItem.Name = PChar(AData));
+  end;
 end;


@ -749,8 +774,6 @@ procedure TXMLDataBindingGenerator.ResolveSchema(ASchema: TXMLDataBindingSchema)
 var
  itemIndex:      Integer;
  item:           TXMLDataBindingItem;
-  forwardItem:    TXMLDataBindingForwardItem;
-  referenceItem:  TXMLDataBindingItem;
  interfaceItem:  TXMLDataBindingInterface;

 begin
@ -769,20 +792,31 @@ begin
        end;

      itForward:
-        begin
+        ResolveItem(ASchema, item);
+    end;
+  end;
+end;
+
+
+procedure TXMLDataBindingGenerator.ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem);
+var
+  forwardItem:    TXMLDataBindingForwardItem;
+  referenceItem:  TXMLDataBindingItem;
+
+begin
+  if (not Assigned(AItem)) or (AItem.ItemType <> itForward) then
+    Exit;
+
  { Resolve forwarded item }
-          forwardItem   := TXMLDataBindingForwardItem(item);
-          referenceItem := FindInterface(ASchema, item.Name, forwardItem.InterfaceType);
+  forwardItem   := TXMLDataBindingForwardItem(AItem);
+  referenceItem := FindInterface(ASchema, AItem.Name, forwardItem.InterfaceType);

  if (not Assigned(referenceItem)) and
     (forwardItem.InterfaceType = ifElement) then
-            referenceItem := FindEnumeration(ASchema, item.Name);
+    referenceItem := FindEnumeration(ASchema, AItem.Name);

  if Assigned(referenceItem) then
-            TXMLDataBindingForwardItem(item).Item := referenceItem;
-        end;
-    end;
-  end;
+    forwardItem.Item  := referenceItem;
 end;


@ -1120,20 +1154,18 @@ end;


 { TXMLDataBindingCollection }
-constructor TXMLDataBindingCollection.Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String);
-begin
-  inherited Create(ASchemaItem, AName);
-
-  FCollectionItem := ACollectionItem;
-end;
-
-
 function TXMLDataBindingCollection.GetItemType(): TXMLDataBindingItemType;
 begin
  Result  := itCollection;
 end;


+procedure TXMLDataBindingCollection.SetCollectionItem(const Value: TXMLDataBindingProperty);
+begin
+  FCollectionItem := Value;
+end;
+
+
 { TXMLDataBindingEnumerationMember }
 constructor TXMLDataBindingEnumerationMember.Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String);
 begin
--- a/X2XMLDataBindingCmdLine.dof
+++ b/X2XMLDataBindingCmdLine.dof
@ -100,7 +100,7 @@ Conditionals=
 DebugSourceDirs=
 UsePackages=0
 [Parameters]
-RunParams="P:\xtx\xtx\xsd\Offerte.xsd" "P:\xtx\xtx\xsd\xml_Offerte.pas"
+RunParams="p:\test\XMLDataBinding\Tests\Data\02. Collection.xsd" "P:\xtx\xtx\xsd\xml_Offerte.pas"
 HostApplication=
 Launcher=
 UseLauncher=0