From 478551716ca1b4d0374bb0cb3439fc36da9d85c0 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 14 Mar 2008 15:35:07 +0000 Subject: [PATCH] Changed: collection behaviour (not yet finished - waiting for named Format implementation) --- ...asic simple and complex types_expected.xml | 4 +- Tests/Data/02. Collection.xsd | 29 +++++ Tests/Data/02. Collection_expected.xml | 59 +++++++++++ Tests/Source/ObjectMappingTests.pas | 58 +++++++--- Tests/X2XMLDataBindingTests.cfg | 6 +- Tests/X2XMLDataBindingTests.dof | 6 +- Tests/XSD/DataBindingResult.xsd | 2 +- Units/DelphiXMLDataBindingGenerator.pas | 18 ++-- Units/XMLDataBindingGenerator.pas | 100 ++++++++++++------ X2XMLDataBindingCmdLine.dof | 2 +- 10 files changed, 217 insertions(+), 67 deletions(-) create mode 100644 Tests/Data/02. Collection.xsd create mode 100644 Tests/Data/02. Collection_expected.xml diff --git a/Tests/Data/01. Basic simple and complex types_expected.xml b/Tests/Data/01. Basic simple and complex types_expected.xml index 2029d8b..218bd31 100644 --- a/Tests/Data/01. Basic simple and complex types_expected.xml +++ b/Tests/Data/01. Basic simple and complex types_expected.xml @@ -5,15 +5,15 @@ 01. Basic simple and complex types - Interface TestElement + Interface Interface - Interface TestComplexType + Interface ComplexType diff --git a/Tests/Data/02. Collection.xsd b/Tests/Data/02. Collection.xsd new file mode 100644 index 0000000..7bdf83f --- /dev/null +++ b/Tests/Data/02. Collection.xsd @@ -0,0 +1,29 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Tests/Data/02. Collection_expected.xml b/Tests/Data/02. Collection_expected.xml new file mode 100644 index 0000000..0f0192a --- /dev/null +++ b/Tests/Data/02. Collection_expected.xml @@ -0,0 +1,59 @@ + + + + + 02. Collection + + + Root + Interface + + Interface + + + + + + ComplexParts + Interface + + Interface + + + + + Collection + ComplexPartList + + ComplexPart + + + + + ComplexPart + Interface + + Interface + + + + + + SimpleParts + Interface + + Interface + + + + + Collection + SimpleValueList + + SimpleValue + + + + + + diff --git a/Tests/Source/ObjectMappingTests.pas b/Tests/Source/ObjectMappingTests.pas index 5e8079e..221a372 100644 --- 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,20 +135,32 @@ end; procedure TObjectMappingTests.CompareItems(ATestResult: TTestResult; AGeneratorSchema: TXMLDataBindingSchema; AResultSchema: IXMLSchema); - function FindItem(const AName: String): TXMLDataBindingItem; + function FindItem(const AResultItem: IXMLItem): TXMLDataBindingItem; var - itemIndex: Integer; + itemType: TXMLDataBindingItemType; + itemIndex: Integer; + item: TXMLDataBindingItem; begin - Result := nil; + 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 + item := AGeneratorSchema.Items[itemIndex]; + + if (item.ItemType = itemType) and + (item.Name = AResultItem.Name) then begin - Result := AGeneratorSchema.Items[itemIndex]; + Result := item; break; end; + end; end; @@ -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 diff --git a/Tests/X2XMLDataBindingTests.cfg b/Tests/X2XMLDataBindingTests.cfg index 92047fd..d636d14 100644 --- 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 diff --git a/Tests/X2XMLDataBindingTests.dof b/Tests/X2XMLDataBindingTests.dof index bd84db2..125dbde 100644 --- 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 diff --git a/Tests/XSD/DataBindingResult.xsd b/Tests/XSD/DataBindingResult.xsd index dc06875..30776df 100644 --- a/Tests/XSD/DataBindingResult.xsd +++ b/Tests/XSD/DataBindingResult.xsd @@ -31,8 +31,8 @@ - + diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index dc6121a..87bd93b 100644 --- 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; diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 84c3bc2..08e3025 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -44,7 +44,7 @@ type function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema; function GetSchemaData(const ALocation: String): TStream; function FindSchema(const ALocation: String): TXMLDataBindingSchema; - + procedure GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); procedure GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); procedure GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema); @@ -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'; @@ -594,9 +596,10 @@ begin Result := interfaceObject; end; - - for elementIndex := 0 to Pred(AElement.ChildElements.Count) do - ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject); + + if Assigned(interfaceObject) then + for elementIndex := 0 to Pred(AElement.ChildElements.Count) do + ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject); end; end; end; @@ -619,10 +622,10 @@ begin begin { Collection } collectionObject := FindCollection(ASchema, AElement.Name); - + 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,23 +792,34 @@ begin end; itForward: - begin - { Resolve forwarded item } - forwardItem := TXMLDataBindingForwardItem(item); - referenceItem := FindInterface(ASchema, item.Name, forwardItem.InterfaceType); - - if (not Assigned(referenceItem)) and - (forwardItem.InterfaceType = ifElement) then - referenceItem := FindEnumeration(ASchema, item.Name); - - if Assigned(referenceItem) then - TXMLDataBindingForwardItem(item).Item := referenceItem; - end; + 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(AItem); + referenceItem := FindInterface(ASchema, AItem.Name, forwardItem.InterfaceType); + + if (not Assigned(referenceItem)) and + (forwardItem.InterfaceType = ifElement) then + referenceItem := FindEnumeration(ASchema, AItem.Name); + + if Assigned(referenceItem) then + forwardItem.Item := referenceItem; +end; + + procedure TXMLDataBindingGenerator.ResolveNameConflicts(); var itemNames: TX2SOHash; @@ -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 diff --git a/X2XMLDataBindingCmdLine.dof b/X2XMLDataBindingCmdLine.dof index dade2ea..357f5f0 100644 --- 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