Sfoglia il codice sorgente

Merged revisions 11494-11496,11515,11518-11521,11523,11528,11534-11535,11542-11545,11551,11553,11555,11557,11562,11564,11567,11571,11573-11574,11576,11588,11601-11603,11606-11610 via svnmerge from
svn+ssh://svn.freepascal.org/FPC/svn/fpc/trunk

........
r11494 | michael | 2008-07-31 13:35:38 +0200 (Thu, 31 Jul 2008) | 1 line

* Added classname to assignparamtostream
........
r11495 | michael | 2008-07-31 13:37:14 +0200 (Thu, 31 Jul 2008) | 1 line

* Use AssignFieldAsStream for stream properties
........
r11496 | michael | 2008-07-31 14:56:09 +0200 (Thu, 31 Jul 2008) | 1 line

* Tablename property
........
r11515 | michael | 2008-08-06 10:29:29 +0200 (Wed, 06 Aug 2008) | 1 line

* Fixed memory leak when destroying TBUFdataset, indexdefs were not freed
........
r11534 | michael | 2008-08-07 14:39:52 +0200 (Thu, 07 Aug 2008) | 1 line

* Additional options implemented
........
r11542 | michael | 2008-08-11 12:03:48 +0200 (Mon, 11 Aug 2008) | 1 line

* Required fielddef property is now set correctly
........
r11543 | michael | 2008-08-11 12:04:30 +0200 (Mon, 11 Aug 2008) | 1 line

* More complete indexdef treatment
........
r11544 | michael | 2008-08-11 12:17:00 +0200 (Mon, 11 Aug 2008) | 1 line

* Data dictionary diff mechanism
........
r11545 | michael | 2008-08-11 12:18:48 +0200 (Mon, 11 Aug 2008) | 1 line

* test for Data dictionary diff mechanism
........
r11567 | michael | 2008-08-14 10:07:16 +0200 (Thu, 14 Aug 2008) | 1 line

* Changed AssertException so "no exception" is displayed if there was no exception
........
r11573 | michael | 2008-08-14 15:19:24 +0200 (Thu, 14 Aug 2008) | 1 line

* Corrections for BCD support
........
r11574 | michael | 2008-08-14 15:20:56 +0200 (Thu, 14 Aug 2008) | 1 line

* Improved import of data dictionary for Interbase connections
........
r11576 | michael | 2008-08-14 16:37:04 +0200 (Thu, 14 Aug 2008) | 1 line

* Correct location for IB import...
........
r11601 | michael | 2008-08-17 16:45:12 +0200 (Sun, 17 Aug 2008) | 1 line

* Added initial support for domains, foreign keys and sequences
........
r11602 | michael | 2008-08-17 16:52:58 +0200 (Sun, 17 Aug 2008) | 1 line

* Firebird/Interbase needs CREATE GENERATOR instead of sequence, added sequence/domain capability
........
r11603 | michael | 2008-08-17 16:56:05 +0200 (Sun, 17 Aug 2008) | 1 line

* Forgot to set capabilities
........
r11606 | michael | 2008-08-18 09:13:51 +0200 (Mon, 18 Aug 2008) | 1 line

* Rework zodat domeinen aangemaakt kunnen worden
........
r11607 | michael | 2008-08-18 10:09:36 +0200 (Mon, 18 Aug 2008) | 1 line

* Domains and sequences are now also written to .ini
........
r11608 | michael | 2008-08-18 11:14:38 +0200 (Mon, 18 Aug 2008) | 1 line

* Added import routines for domains/seqences, and populate code
........
r11609 | michael | 2008-08-18 12:05:52 +0200 (Mon, 18 Aug 2008) | 1 line

* Diff domains and sequences
........
r11610 | michael | 2008-08-18 12:58:00 +0200 (Mon, 18 Aug 2008) | 1 line

* Patch from Vincent Snijders to fix EscapeText
........

git-svn-id: branches/fixes_2_2@12081 -

michael 17 anni fa
parent
commit
efb6a55a23

+ 2 - 0
.gitattributes

@@ -1139,6 +1139,7 @@ packages/fcl-db/src/datadict/buildd.lpi svneol=native#text/plain
 packages/fcl-db/src/datadict/buildd.lpr svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdatadict.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpdddbf.pp svneol=native#text/plain
+packages/fcl-db/src/datadict/fpdddiff.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddfb.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql40.pp svneol=native#text/plain
 packages/fcl-db/src/datadict/fpddmysql41.pp svneol=native#text/plain
@@ -1289,6 +1290,7 @@ packages/fcl-db/tests/sqldbtoolsunit.pas -text
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
 packages/fcl-db/tests/testdbbasics.pas -text
+packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testsqlscript.pas svneol=native#text/plain
 packages/fcl-db/tests/toolsunit.pas -text

+ 3 - 3
packages/fcl-base/src/whtml.pp

@@ -136,9 +136,9 @@ end;
 function THTMLWriter.EscapeText(AText: String): String;
 begin
   // replace by a more sensitive method.
-  Result:=StringReplace(AText,'&','&amp',[rfReplaceAll]);
-  Result:=StringReplace(Result,'<','&lt',[rfReplaceAll]);
-  Result:=StringReplace(Result,'>','&gt',[rfReplaceAll]);
+  Result:=StringReplace(AText,'&','&amp;',[rfReplaceAll]);
+  Result:=StringReplace(Result,'<','&lt;',[rfReplaceAll]);
+  Result:=StringReplace(Result,'>','&gt;',[rfReplaceAll]);
   Result:=StringReplace(Result,#10,'<BR>',[rfreplaceAll]);
 end;
 

+ 9 - 0
packages/fcl-db/src/base/bufdataset.pas

@@ -398,7 +398,16 @@ begin
 end;
 
 destructor TBufDataset.Destroy;
+
+Var
+  I : Integer;
 begin
+  SetLength(FUpdateBuffer,0);
+  SetLength(FBlobBuffers,0);
+  SetLength(FUpdateBlobBuffers,0);
+  For I:=0 to Length(FIndexes)-1 do
+    FreeAndNil(Findexes[I]);
+  SetLength(FIndexes,0);
   FreeAndNil(FIndexDefs);
   inherited destroy;
 end;

+ 59 - 59
packages/fcl-db/src/codegen/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/15]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/23]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -261,178 +261,178 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)

+ 1 - 1
packages/fcl-db/src/codegen/Makefile.fpc

@@ -9,7 +9,7 @@ main=fcl-db
 packages=fcl-base
 
 [target]
-units=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf
+units=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf fpddpopcode
 
 [compiler]
 options=-S2h

+ 284 - 78
packages/fcl-db/src/codegen/fpcgtiopf.pp

@@ -25,7 +25,8 @@ uses
 TYpe
   TClassOption = (caCreateClass,caConstructor,caDestructor,caCreateList,caListAddMethod,caListItemsProperty);
   TClassOptions = Set of TClassOption;
-  TVisitorOption = (voRead,voReadList,voCreate,voDelete,voUpdate);
+  TVisitorOption = (voRead,voReadList,voCreate,voDelete,voUpdate,
+                    voCommonSetupParams,voSingleSaveVisitor);
   TVisitorOptions = set of TVisitorOption;
   
   { TTiOPFCodeOptions }
@@ -33,21 +34,27 @@ TYpe
   TTiOPFCodeOptions = Class (TClassCodeGeneratorOptions)
   Private
     FClassOptions: TClassOptions;
+    FFinalVisitors: TVisitorOptions;
     FListAncestorName: String;
     FListClassName : String;
     FVisitorOptions: TVisitorOptions;
+    FTableName : String;
     function GetListClassName: String;
+    procedure SetClassOptions(const AValue: TClassOptions);
     procedure SetListAncestorName(const AValue: String);
     procedure SetListClassName(const AValue: String);
+    procedure SetVisitorOptions(const AValue: TVisitorOptions);
   Public
     Constructor Create; override;
     Procedure Assign(ASource : TPersistent); override;
   Published
-    Property ClassOptions : TClassOptions Read FClassOptions Write FClassOptions;
-    Property VisitorOptions : TVisitorOptions Read FVisitorOptions Write FVisitorOptions;
+    Property ClassOptions : TClassOptions Read FClassOptions Write SetClassOptions;
+    Property VisitorOptions : TVisitorOptions Read FVisitorOptions Write SetVisitorOptions;
+    Property FinalVisitors : TVisitorOptions Read FFinalVisitors Write FFinalVisitors;
     Property ListAncestorName : String Read FListAncestorName Write SetListAncestorName;
     Property ListClassName : String Read GetListClassName Write SetListClassName;
     Property AncestorClass;
+    Property TableName : String Read FTableName Write FTableName;
   end;
   
   { TTiOPFCodeGenerator }
@@ -63,15 +70,24 @@ TYpe
   private
     Function CreateSQLStatement(V: TVisitorOption) : String;
     function GetOpt: TTiOPFCodeOptions;
-    procedure WriteCreateVisitor(Strings: TStrings; const ObjectClassName: String);
-    procedure WriteDeleteVisitor(Strings: TStrings; const ObjectClassName: String);
+    Function UseCommonSetupParams : Boolean;
+    Function SingleSaveVisitor : Boolean;
+    Function VisitorClassName(V : TVisitorOption; Const ObjectClassName : String) : String;
+    // Auxiliary routines
     procedure WriteFieldAssign(Strings: TStrings; F: TFieldPropDef);
     procedure WriteAssignToParam(Strings: TStrings; F: TFieldPropDef);
-    procedure WriteReadListVisitor(Strings: TStrings; const ObjectClassName: String);
-    procedure WriteReadVisitor(Strings: TStrings; const ObjectClassName: String );
     procedure WriteSetSQL(Strings: TStrings; const ASQL: String);
     procedure WriteSQLConstants(Strings: TStrings);
+    Procedure WriteTerminateVisitor(Strings : TStrings; V : TVisitorOption; const ObjectClassName: String);
+    procedure WriteSetupParams(Strings: TStrings; const AClassName, ObjectClassName: String);
+    // Visitors
+    procedure WriteCommonSetupVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteSaveVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteCreateVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteDeleteVisitor(Strings: TStrings; const ObjectClassName: String);
     procedure WriteUpdateVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteReadListVisitor(Strings: TStrings; const ObjectClassName: String);
+    procedure WriteReadVisitor(Strings: TStrings; const ObjectClassName: String );
     procedure WriteVisitorDeclaration(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
     procedure WriteVisitorImplementation(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String);
   Protected
@@ -97,10 +113,19 @@ TYpe
   end;
 
 Const
-  SOID = 'OID'; // OID property.
+  SOID = 'OID';              // OID property.
+  SDefTableName = 'MYTABLE'; // Default table name.
   
 implementation
 
+Function StripType(S : String) : string;
+
+begin
+  Result:=S;
+  If (Result<>'') and (Result[1]='T') then
+    Delete(Result,1,1);
+end;
+
 { TTiOPFCodeOptions }
 
 function TTiOPFCodeOptions.GetListClassName: String;
@@ -110,6 +135,20 @@ begin
     Result:=ObjectClassName+'List';
 end;
 
+procedure TTiOPFCodeOptions.SetClassOptions(const AValue: TClassOptions);
+
+Var
+  B : Boolean;
+
+begin
+  If AValue=FClassOptions then
+    Exit;
+  B:=Not(caCreateList in FClassOptions) and (caCreateList in AValue);
+  FClassOptions:=AValue;
+  If B then
+    Include(FVisitorOptions,voReadList);
+end;
+
 procedure TTiOPFCodeOptions.SetListAncestorName(const AValue: String);
 begin
   CheckIdentifier(AValue,False);
@@ -122,14 +161,40 @@ begin
   FListClassName:=AValue;
 end;
 
+procedure TTiOPFCodeOptions.SetVisitorOptions(const AValue: TVisitorOptions);
+
+Var
+  V : TVisitorOption;
+
+begin
+  FVisitorOptions:=AValue;
+  // Consistency check
+  If voSingleSaveVisitor in FVisitorOptions then
+    begin
+    Exclude(FVisitorOptions,voCommonSetupParams);
+    Exclude(FVisitorOptions,voCreate);
+    Exclude(FVisitorOptions,voUpdate);
+    Exclude(FVisitorOptions,voDelete);
+    end
+  else If voCommonSetupParams in FVisitorOptions then
+    begin
+    Include(FVisitorOptions,voCreate);
+    Include(FVisitorOptions,voUpdate);
+    end;
+  For V:=Low(TVisitorOption) to High(TVisitorOption) do
+    If Not (V in FVisitorOptions) then
+      Exclude(FFinalVisitors,V);
+end;
+
 constructor TTiOPFCodeOptions.Create;
 begin
   inherited Create;
   FListAncestorName:='TTiObjectList';
   AncestorClass:='TTiObject';
   ObjectClassName:='MyObject';
+  TableName:=SDefTableName;
   FVisitorOptions:=[voRead,voCreate,voDelete,voUpdate];
-  FClassOptions:=[caCreateList,caListAddMethod,caListItemsProperty];
+  FClassOptions:=[caCreateClass,caCreateList,caListAddMethod,caListItemsProperty];
 end;
 
 procedure TTiOPFCodeOptions.Assign(ASource: TPersistent);
@@ -145,6 +210,8 @@ begin
     AncestorClass:=OC.AncestorClass;
     FVisitorOptions:=OC.FVisitorOptions;
     FClassOptions:=OC.FClassOptions;
+    FTableName:=OC.TableName;
+    FFinalVisitors:=OC.FinalVisitors;
     end;
   inherited Assign(ASource);
 end;
@@ -181,6 +248,122 @@ begin
   Result:=CodeOptions as TTiOPFCodeOptions;
 end;
 
+function TTiOPFCodeGenerator.UseCommonSetupParams: Boolean;
+begin
+  Result:=VoCommonSetupParams in tiOPFOptions.VisitorOptions;
+end;
+
+function TTiOPFCodeGenerator.SingleSaveVisitor: Boolean;
+begin
+  Result:=voSingleSaveVisitor in tiOPFOptions.VisitorOptions;
+end;
+
+function TTiOPFCodeGenerator.VisitorClassName(V: TVisitorOption;
+  const ObjectClassName: String): String;
+
+Var
+  S : String;
+
+begin
+  Case V of
+    voRead        : S:='Read';
+    voReadList    : S:='ReadList';
+    voCreate      : S:='Create';
+    voDelete      : S:='Delete';
+    voUpdate      : S:='Update';
+    voCommonSetupParams : S:='UpdateCreate';
+    voSingleSaveVisitor : S:='Save';
+  else
+    Result:='Unknown';
+  end;
+  // Real class name
+  Result:=Format('T%s%sVisitor',[S,StripType(ObjectClassName)]);
+end;
+
+procedure TTiOPFCodeGenerator.WriteCommonSetupVisitor(Strings: TStrings;
+  const ObjectClassName: String);
+
+
+Var
+  CS,C,S : String;
+  I : Integer;
+
+begin
+  C:=VisitorClassName(voCommonSetupParams,ObjectClassName);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  WriteSetupParams(Strings,C,ObjectClassName);
+end;
+
+procedure TTiOPFCodeGenerator.WriteSaveVisitor(Strings: TStrings; const ObjectClassName: String);
+
+  Procedure WriteSQLCase(Const ACaselabel,ASQL : String);
+
+  begin
+    addln(Strings,ACaseLabel+':');
+    incIndent;
+    WriteSetSQL(Strings,ASQL);
+    DecIndent;
+  end;
+
+Var
+  OCN,CS,C,S : String;
+  I : Integer;
+  F : TFieldPropDef;
+
+begin
+  OCN:=StripType(ObjectClassName);
+  C:=VisitorClassName(voSingleSaveVisitor,OCN);
+  Addln(Strings,'{ %s }',[C]);
+  Addln(Strings);
+  // Init
+  S:=BeginInit(Strings,C);
+  AddLn(Strings,'Case Visited.ObjectState of');
+  IncIndent;
+  try
+    WriteSQLCase('posCreate',Format('SQLCreate%s',[OCN]));
+    WriteSQLCase('posUpdate',Format('SQLUpdate%s',[OCN]));
+    WriteSQLCase('posDelete',Format('SQLDelete%s',[OCN]));
+  finally
+    DecIndent;
+  end;
+  Addln(Strings,'end;');
+  DecIndent;
+  EndMethod(Strings,S);
+  // AcceptVisitor
+  S:=BeginAcceptVisitor(Strings,C,ObjectClassName);
+  AddLn(Strings,'Result:=Result and (Visited.ObjectState in [posCreate,posdelete,posUpdate]);');
+  DecIndent;
+  EndMethod(Strings,S);
+  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
+  Addln(Strings,'With Query do',[ObjectClassName]);
+  IncINdent;
+  try
+    Addln(Strings,'begin');
+    F:=Fields.FindPropName('OID');
+    If (F<>Nil) then
+      WriteAssignToParam(Strings,F)
+    else
+      AddLn(Strings,'// No OID property found. Add delete key parameter setup code here.');
+    AddLn(Strings,'If (Visited.ObjectState<>posDelete) then');
+    IncIndent;
+    try
+      AddLn(Strings,'begin');
+      For I:=0 to Fields.Count-1 do
+        If Fields[i].Enabled and (CompareText(Fields[i].PropertyName,'OID')<>0) then
+          WriteAssignToParam(Strings,Fields[i]);
+      AddLn(Strings,'end;');
+    Finally
+      DecIndent;
+    end;
+    Addln(Strings,'end;');
+  finally
+    DecIndent;
+  end;
+  DecIndent;
+  EndMethod(Strings,S);
+end;
+
 function TTiOPFCodeGenerator.GetInterfaceUsesClause: string;
 begin
   Result:=inherited GetInterfaceUsesClause;
@@ -208,8 +391,10 @@ begin
     try
       If caCreateList in ClassOptions then
         CreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName);
+      If voCommonSetupParams in VisitorOptions then
+        WriteVisitorDeclaration(Strings,voCommonSetupParams,ObjectClassName);
       For V:=Low(TVisitorOption) to High(TVisitorOption) do
-        If V in VisitorOptions then
+        If (V in VisitorOptions) and (V<>voCommonSetupParams) then
           WriteVisitorDeclaration(Strings,V,ObjectClassName);
     Finally
       DecIndent;
@@ -217,13 +402,6 @@ begin
     end;
 end;
 
-Function StripType(S : String) : string;
-
-begin
-  Result:=S;
-  If (Result<>'') and (Result[1]='T') then
-    Delete(Result,1,1);
-end;
 
 procedure TTiOPFCodeGenerator.WriteVisitorDeclaration(Strings : TStrings; V : TVisitorOption; Const ObjectClassName : String);
 
@@ -231,28 +409,34 @@ Var
   S,T,A : string;
 
 begin
-  Case V of
-    voRead     : S:='Read';
-    voReadList : S:='ReadList';
-    voCreate   : S:='Create';
-    voDelete   : S:='Delete';
-    voUpdate   : S:='Update';
-  end;
-  If V in [voCreate,voDelete,voUpdate] then
-    A:='Update'
+  // Ancestor name
+  // Common setup case
+  If (V in [voCreate,voUpdate]) and (UseCommonSetupParams) then
+    A:=Format('TUpdateCreate%sVisitor',[StripType(ObjectClassName)])
+  else If (V in [voCreate,voDelete,voUpdate,voCommonSetupParams]) then
+    A:='TtiVisitorUpdate'
   else
-    A:='Select';
-  S:=Format('T%s%sVisitor',[S,StripType(ObjectClassName)]);
+    A:='TtiVisitorSelect';
+  // Real class
+  S:=VisitorClassName(V,ObjectClassName);
   AddLn(Strings,'{ %s }',[S]);
-  AddlN(Strings,'%s = Class(TtiVisitor%s)',[S,A]);
+  AddlN(Strings,'%s = Class(%s)',[S,A]);
   AddlN(Strings,'Protected');
   IncIndent;
   Try
-    AddLn(Strings,'Procedure Init; override;');
-    AddLn(Strings,'Function AcceptVisitor : Boolean; override;');
-    AddLn(Strings,'Procedure SetupParams; override;');
-    If Not (V in [voCreate,voDelete,voUpdate]) then
+    If (V<>VoCommonSetupParams) then
+      begin
+      AddLn(Strings,'Procedure Init; override;');
+      AddLn(Strings,'Function AcceptVisitor : Boolean; override;');
+      If Not ((V in [voCreate,voUpdate]) and UseCommonSetupParams) then
+        AddLn(Strings,'Procedure SetupParams; override;');
+      end
+    else
+      AddLn(Strings,'Procedure SetupParams; override;');
+    If (V in [voRead,voReadList]) then
       AddLn(Strings,'Procedure MapRowToObject; override;');
+    if (V in TiOPFOptions.FinalVisitors) then
+      Addln(Strings,'Procedure Execute(Const AData : TtiVisited); override;');
   Finally
     DecIndent;
   end;
@@ -277,7 +461,9 @@ Var
   F : TFieldPropDef;
 
 begin
-  TN:='MyTable';
+  TN:=TiOPFOptions.TableName;
+  If (TN='') then 
+    TN:=SDefTableName;
   S:='';
   VS:='';
   W:='Your condition here';
@@ -340,7 +526,7 @@ procedure TTiOPFCodeGenerator.WriteSQLConstants(Strings : TStrings);
 
 Const
   VisSQL : Array [TVisitorOption] of string
-         = ('Read','ReadList','Create','Delete','Update');
+         = ('Read','ReadList','Create','Delete','Update','','');
 
 Var
   OCN,S : String;
@@ -352,7 +538,8 @@ begin
   try
     OCN:=StripType(TiOPFOptions.ObjectClassName);
     For V:=Low(TVisitorOption) to High(TVisitorOption) do
-      If V in TiOPFOptions.VisitorOptions then
+      If ((V in TiOPFOptions.VisitorOptions) or
+           (SingleSaveVisitor and (V in [voCreate,voUpdate,voDelete]))) and (VisSQL[V]<>'') then
         begin
         S:=CreateSQLStatement(V);
         S:=Format('SQL%s%s = ''%s'';',[VisSQL[V],OCN,S]);
@@ -364,6 +551,33 @@ begin
   AddLn(Strings,'');
 end;
 
+procedure TTiOPFCodeGenerator.WriteTerminateVisitor(Strings  : TStrings;V : TVisitorOption;
+  const ObjectClassName: String);
+
+Var
+  S  : String;
+begin
+  S:=VisitorclassName(V,ObjectClassName);
+  S:=Format('Procedure %s.Execute(Const AData : TtiVisited);',[S]);
+  BeginMethod(Strings,S);
+  AddLn(Strings,'begin');
+  IncIndent;
+  try
+    AddLn(Strings,'Inherited Execute(AData);');
+    Addln(Strings,'If not AcceptVisitor then');
+    IncIndent;
+    Try
+      Addln(Strings,'Exit; // ==>');
+    Finally
+      DecIndent;
+    end;
+    AddLn(Strings,'ContinueVisiting:=False;');
+  Finally
+    DecIndent;
+  end;
+  EndMethod(Strings,S);
+end;
+
 
 procedure TTiOPFCodeGenerator.DoGenerateImplementation(Strings: TStrings);
 
@@ -393,12 +607,16 @@ procedure TTiOPFCodeGenerator.WriteVisitorImplementation(Strings : TStrings; V :
 
 begin
   Case V of
-    voRead     : WriteReadVisitor(Strings,ObjectClassName);
-    voReadList : WriteReadListVisitor(Strings,ObjectClassName);
-    voCreate   : WriteCreateVisitor(Strings,ObjectClassName);
-    voDelete   : WriteDeleteVisitor(Strings,ObjectClassName);
-    voUpdate   : WriteUpdateVisitor(Strings,ObjectClassName);
+    voRead              : WriteReadVisitor(Strings,ObjectClassName);
+    voReadList          : WriteReadListVisitor(Strings,ObjectClassName);
+    voCreate            : WriteCreateVisitor(Strings,ObjectClassName);
+    voDelete            : WriteDeleteVisitor(Strings,ObjectClassName);
+    voUpdate            : WriteUpdateVisitor(Strings,ObjectClassName);
+    voCommonSetupParams : WriteCommonSetupVisitor(Strings,ObjectClassName);
+    voSingleSaveVisitor : WriteSaveVisitor(Strings,ObjectClassName);
   end;
+  If v in TiOPFOptions.FinalVisitors then
+    WriteTerminateVisitor(Strings,V,ObjectClassName);
 end;
 
 Function TTiOPFCodeGenerator.BeginInit(Strings : TStrings; const AClass : String) : String;
@@ -470,7 +688,7 @@ Var
 begin
   OCN:=StripType(ObjectClassName);
   CS:=Format('SQLRead%s',[OCN]);
-  C:=Format('TRead%sVisitor',[OCN]);
+  C:=VisitorClassName(voRead,OCN);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
@@ -526,13 +744,9 @@ begin
         S:='AsBoolean';
       ptShortint, ptByte,
       ptSmallInt, ptWord,
-      ptLongint, ptCardinal :
+      ptLongint, ptCardinal,
+      ptInt64:
         S:='AsInteger';
-      ptInt64, ptQWord:
-        If F.FieldType=ftLargeInt then
-          R:=Format('O.%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
-        else
-          S:='AsInteger';
       ptShortString, ptAnsiString, ptWideString :
         S:='AsString';
       ptSingle, ptDouble, ptExtended, ptComp :
@@ -546,7 +760,7 @@ begin
       ptSet :
         S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
       ptStream :
-        R:=Format('FieldByName(%s).SaveToStream(O.%s);',[SFN,PN]);
+        R:=Format('AssignFieldAsStream(%s,O.%s);',[SFN,PN]);
       ptTStrings :
         R:=Format('O.%s.Text:=FieldAsString[%s];',[PN,SFN]);
       ptCustom :
@@ -574,13 +788,9 @@ begin
         S:='AsBoolean';
       ptShortint, ptByte,
       ptSmallInt, ptWord,
-      ptLongint, ptCardinal :
+      ptLongint, ptCardinal,
+      ptInt64, ptQWord :
         S:='AsInteger';
-      ptInt64, ptQWord:
-        If F.FieldType=ftLargeInt then
-          R:=Format('O.%s:=(Name(%s) as TLargeIntField).AsLargeInt;',[PN,SFN])
-        else
-          S:='AsInteger';
       ptShortString, ptAnsiString, ptWideString :
         S:='AsString';
       ptSingle, ptDouble, ptExtended, ptComp :
@@ -594,7 +804,7 @@ begin
       ptSet :
         S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]);
       ptStream :
-        R:=Format('AssignParamFromStream(%s,%s);',[SFN,PN]);
+        R:=Format('AssignParamFromStream(%s,O.%s);',[SFN,PN]);
       ptTStrings :
         R:=Format('ParamAsString[%s]:=O.%s.Text;',[SFN,PN]);
       ptCustom :
@@ -619,7 +829,7 @@ begin
   LN:=tiOPFOptions.ListClassName;
   OCN:=StripType(ObjectClassName);
   CS:=Format('SQLReadList%s',[OCN]);
-  C:=Format('TReadList%sVisitor',[StripType(OCN)]);
+  C:=VisitorClassName(voReadList,OCN);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
@@ -669,7 +879,7 @@ Var
 begin
   OCN:=StripType(ObjectClassName);
   CS:=Format('SQLCreate%s',[OCN]);
-  C:=Format('TCreate%sVisitor',[OCN]);
+  C:=VisitorClassName(voCreate,OCN);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
@@ -682,8 +892,19 @@ begin
   AddLn(Strings,'Result:=Result and (Visited.ObjectState=posCreate);');
   DecIndent;
   EndMethod(Strings,S);
+  If Not (UseCommonSetupParams) then
+    WriteSetupParams(Strings,C,ObjectClassName);
+end;
+
+procedure TTiOPFCodeGenerator.WriteSetupParams(Strings : TStrings; Const AClassName,ObjectClassName : String);
+
+Var
+  S : String;
+  I : Integer;
+
+begin
   // SetupParams
-  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
+  S:=BeginSetupParams(Strings,AClassName,ObjectClassName,True);
   Addln(Strings,'With Query do',[ObjectClassName]);
   IncINdent;
   try
@@ -714,7 +935,7 @@ Var
 begin
   OCN:=StripType(ObjectClassName);
   CS:=Format('SQLDelete%s',[OCN]);
-  C:=Format('TDelete%sVisitor',[StripType(ObjectClassName)]);
+  C:=VisitorClassName(voDelete,OCN);
   Addln(Strings,'{ %s }',[C]);
   // Init
   S:=BeginInit(Strings,C);
@@ -746,7 +967,7 @@ Var
 begin
   OCN:=StripType(ObjectClassName);
   CS:=Format('SQLUpdate%s',[OCN]);
-  C:=Format('TUpdate%sVisitor',[OCN]);
+  C:=VisitorClassName(voUpdate,OCN);
   Addln(Strings,'{ %s }',[C]);
   Addln(Strings);
   // Init
@@ -759,26 +980,11 @@ begin
   AddLn(Strings,'Result:=Result and (Visited.ObjectState=posUpdate);');
   DecIndent;
   EndMethod(Strings,S);
-  // SetupParams
-  S:=BeginSetupParams(Strings,C,ObjectClassName,True);
-  Addln(Strings,'With Query do',[ObjectClassName]);
-  IncINdent;
-  try
-    Addln(Strings,'begin');
-    For I:=0 to Fields.Count-1 do
-      If Fields[i].Enabled then
-        WriteAssignToParam(Strings,Fields[i]);
-    Addln(Strings,'end;');
-  finally
-    DecIndent;
-  end;
-  DecIndent;
-  EndMethod(Strings,S);
+  If Not (UseCommonSetupParams) then
+    WriteSetupParams(Strings,C,ObjectClassName);
 end;
 
 
-
-
 { ---------------------------------------------------------------------
   List object commands
   ---------------------------------------------------------------------}

+ 208 - 10
packages/fcl-db/src/codegen/fpddpopcode.pp

@@ -8,7 +8,8 @@ uses
   Classes, SysUtils, typinfo, fpdatadict, db;
 
 Type
-  TDDCodeGenOption = (dcoFields,dcoIndexes,dcoProcedurePerTable,dcoUseWith,dcoClassDecl);
+  TDDCodeGenOption = (dcoFields,dcoIndexes,dcoProcedurePerTable,dcoUseWith,
+                      dcoClassDecl,dcoGenerators,dcoDomains,dcoMergeDomains);
   TDDCodeGenOptions = Set of TDDCodeGenoption;
   
   { TFPDDPopulateCodeGenerator }
@@ -45,11 +46,24 @@ Type
     Function DoTable (Const ATable : TDDtableDef) : Boolean; virtual;
     procedure CreateTableCode(T: TDDTableDef; Lines: TStrings);
     procedure AddTableVars(Lines: TStrings);
+    procedure AddDomainVars(Lines: TStrings);
+    procedure AddSequenceVars(Lines: TStrings);
     procedure DoTableHeader(ATable: TDDTableDef; Lines: TStrings);
     procedure DoTableFooter(ATable: TDDTableDef; Lines: TStrings);
     // Field code
     Function DoField (Const ATable : TDDtableDef; Const AField : TDDFieldDef) : Boolean; virtual;
     procedure CreateFieldCode(ATable: TDDTableDef; AField: TDDFieldDef;  Lines: TStrings);
+    // Index code
+    Function DoIndex (Const ATable : TDDtableDef; Const AIndex : TDDIndexDef) : Boolean; virtual;
+    procedure CreateIndexCode(ATable: TDDTableDef; AIndex: TDDIndexDef;  Lines: TStrings);
+    // Sequence code
+    Procedure WriteSequences(Const ASequences : TDDSequenceDefs; Lines :TStrings);
+    Function DoSequence (Const ASequence : TDDSequenceDef) : Boolean; virtual;
+    procedure CreateSequenceCode(ASequence: TDDSequenceDef;  Lines: TStrings);
+    // Domain code
+    Procedure WriteDomains(Const ADomains : TDDDomainDefs; Lines :TStrings);
+    Function DoDomain (Const ADomain : TDDDomainDef) : Boolean; virtual;
+    procedure CreateDomainCode(ADomain: TDDDomainDef;  Lines: TStrings);
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
@@ -179,6 +193,24 @@ begin
   AddLine('T : TDDTableDef;',lines);
   If dcoFields in Options then
     AddLine('F : TDDFieldDef;',lines);
+  If dcoIndexes in Options then
+    AddLine('ID : TDDIndexDef;',lines);
+  Undent;
+end;
+
+procedure TFPDDPopulateCodeGenerator.AddDomainVars(Lines: TStrings);
+begin
+  AddLine('Var',Lines);
+  Indent;
+  AddLine('D : TDDDomainDef;',lines);
+  Undent;
+end;
+
+procedure TFPDDPopulateCodeGenerator.AddSequenceVars(Lines: TStrings);
+begin
+  AddLine('Var',Lines);
+  Indent;
+  AddLine('D : TDDSequenceDef;',lines);
   Undent;
 end;
 
@@ -234,6 +266,10 @@ end;
 
 procedure TFPDDPopulateCodeGenerator.CreateFieldCode(ATable : TDDTableDef; AField : TDDFieldDef; Lines: TStrings);
 
+Var
+  I : Integer;
+  S : String;
+
 begin
   AddLine(Format('F:=T.Fields.AddField(''%s'');',[AField.FieldName]),Lines);
   If (dcoUseWith in Options) then
@@ -251,17 +287,24 @@ begin
   AddStringProperty('F','DBDefault',AField.DBDefault,Lines);
   AddStringProperty('F','DefaultExpression',AField.DefaultExpression,Lines);
   AddStringProperty('F','DisplayLabel',AField.DisplayLabel,Lines);
+  AddStringProperty('F','DomainName',AField.DomainName,Lines);
   If (AField.DisplayWidth<>0) then
-    AddProperty('F','DisplayWidth',IntToStr(AField.DisplayWidth),Lines);
+    AddProperty('F','DisplayWidth1',IntToStr(AField.DisplayWidth),Lines);
   AddStringProperty('F','Constraint',AField.Constraint,Lines);
   AddProperty('F','ReadOnly',AField.ReadOnly,Lines);
-  AddProperty('F','Required',AField.Required,Lines);
+  If (dcoMergeDomains in Options) then
+    AddProperty('F','Required',AField.FieldIsRequired,Lines)
+  else
+    AddProperty('F','Required',AField.Required,Lines);
   AddProperty('F','Visible',AField.Visible,Lines);
   If (AField.Size<>0) then
     AddProperty('F','Size',IntToStr(AField.Size),Lines);
   If (AField.Precision<>0) then
     AddProperty('F','Precision',IntToStr(AField.Precision),Lines);
   AddStringProperty('F','Hint',AField.Hint,Lines);
+  I:=Integer(AField.ProviderFlags);
+  S:=SetToString(PTypeInfo(TypeInfo(TProviderFlags)),I,True);
+  AddProperty('F','ProviderFlags',S,Lines);
   If (dcoUseWith in Options) then
      begin
      AddLine('end;',Lines);
@@ -269,6 +312,149 @@ begin
      end;
 end;
 
+function TFPDDPopulateCodeGenerator.DoIndex(const ATable: TDDtableDef;
+  const AIndex: TDDIndexDef): Boolean;
+begin
+  Result:=Assigned(ATable) and Assigned(AIndex);
+end;
+
+procedure TFPDDPopulateCodeGenerator.CreateIndexCode(ATable: TDDTableDef;
+  AIndex: TDDIndexDef; Lines: TStrings);
+
+Var
+  S : string;
+  I : Integer;
+
+begin
+  AddLine(Format('ID:=T.Indexes.AddIndex(''%s'');',[AIndex.IndexName]),Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('With ID do',Lines);
+     Indent;
+     AddLine('begin',Lines);
+     end;
+  AddStringProperty('ID','Expression',AIndex.Expression,Lines);
+  AddStringProperty('ID','Fields',AIndex.Fields,Lines);
+  AddStringProperty('ID','CaseInsFields',AIndex.CaseInsFields,Lines);
+  AddStringProperty('ID','DescFields',AIndex.DescFields,Lines);
+  AddStringProperty('ID','Source',AIndex.Source,Lines);
+  I:=Integer(AIndex.Options);
+  S:=SetToString(PTypeInfo(TypeInfo(TIndexOptions)),I,True);
+  AddProperty('ID','Options',S,Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('end;',Lines);
+     Undent;
+     end;
+
+end;
+
+procedure TFPDDPopulateCodeGenerator.WriteSequences(
+  const ASequences: TDDSequenceDefs; Lines: TStrings);
+
+Var
+  I : Integer;
+  S : TDDSequenceDef;
+
+begin
+  If (dcoProcedurePerTable in Options) then
+    begin
+    AddProcedure('PopulateSequences',Lines);
+    AddSequenceVars(Lines);
+    AddLine('',Lines);
+    AddLine('begin',Lines);
+    Indent;
+    end;
+  For I:=0 to ASequences.Count-1 do
+    begin
+    S:=ASequences[i];
+    If DoSequence(S) then
+      CreateSequenceCode(S,Lines);
+    end;
+  If (dcoProcedurePerTable in Options) then
+    EndProcedure(Lines);
+end;
+
+function TFPDDPopulateCodeGenerator.DoSequence(const ASequence: TDDSequenceDef): Boolean;
+begin
+  Result:=Assigned(ASequence);
+end;
+
+procedure TFPDDPopulateCodeGenerator.CreateSequenceCode(ASequence: TDDSequenceDef; Lines: TStrings);
+begin
+  AddLine(Format('S:=%s.Sequences.AddSequence(''%s'');',[FDDV,ASequence.SequenceName]),Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('With S do',Lines);
+     Indent;
+     AddLine('begin',Lines);
+     end;
+  If (ASequence.StartValue<>0) then
+    AddProperty('S','StartValue',IntToStr(ASequence.StartValue),Lines);
+  If (ASequence.Increment<>0) then
+    AddProperty('S','Increment',IntToStr(ASequence.Increment),Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('end;',Lines);
+     Indent;
+     end;
+end;
+
+procedure TFPDDPopulateCodeGenerator.WriteDomains(const ADomains: TDDDomainDefs; Lines :TStrings);
+
+Var
+  I : Integer;
+  D : TDDDomainDef;
+
+begin
+  If (dcoProcedurePerTable in Options) then
+    begin
+    AddProcedure('PopulateDomains',Lines);
+    AddDomainVars(Lines);
+    AddLine('',Lines);
+    AddLine('begin',Lines);
+    Indent;
+    end;
+  For I:=0 to FDD.Domains.Count-1 do
+    begin
+    D:=FDD.Domains[i];
+    If DoDomain(D) then
+      CreateDomainCode(D,Lines);
+    end;
+  If (dcoProcedurePerTable in Options) then
+    EndProcedure(Lines);
+end;
+
+function TFPDDPopulateCodeGenerator.DoDomain(const ADomain: TDDDomainDef
+  ): Boolean;
+begin
+  Result:=Assigned(ADomain);
+end;
+
+procedure TFPDDPopulateCodeGenerator.CreateDomainCode(ADomain: TDDDomainDef;
+  Lines: TStrings);
+begin
+  AddLine(Format('D:=%s.Domains.AddDomain(''%s'');',[FDDV,ADomain.DomainName]),Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('With D do',Lines);
+     Indent;
+     AddLine('begin',Lines);
+     end;
+  if (ADomain.FieldType<>ftUnknown) then
+    AddProperty('D','FieldType',GetEnumName(TypeInfo(TFieldType),Ord(ADomain.FieldType)),Lines);
+  AddProperty('D','Required',ADomain.Required,Lines);
+  If (ADomain.Size<>0) then
+    AddProperty('D','Size',IntToStr(ADomain.Size),Lines);
+  If (ADomain.Precision<>0) then
+    AddProperty('D','Precision',IntToStr(ADomain.Precision),Lines);
+  If (dcoUseWith in Options) then
+     begin
+     AddLine('end;',Lines);
+     Indent;
+     end;
+end;
+
 procedure TFPDDPopulateCodeGenerator.CreateHeader(Lines: TStrings);
 
 begin
@@ -315,7 +501,8 @@ procedure TFPDDPopulateCodeGenerator.CreateTableCode(T : TDDTableDef; Lines: TSt
 Var
   I : Integer;
   F : TDDFieldDef;
-  
+  Id : TDDindexDef;
+
 begin
   DoTableHeader(T,Lines);
   try
@@ -326,6 +513,13 @@ begin
         If DoField(T,F) then
           CreateFieldcode(T,F,Lines);
         end;
+    If dcoIndexes in Options then
+      For I:=0 to T.Indexes.Count-1 Do
+        begin
+        ID:=T.Indexes[I];
+        If DoIndex(T,ID) then
+          CreateIndexCode(T,ID,Lines);
+        end;
   Finally
     DoTableFooter(T,Lines);
   end;
@@ -369,12 +563,16 @@ begin
   try
     CreateHeader(Lines);
     Try
-    For I:=0 to FDD.Tables.Count-1 do
-      begin
-      T:=FDD.Tables[i];
-      If DoTable(T) then
-        CreateTableCode(T,Lines);
-      end;
+      If (FDD.Domains.Count>0) then
+        WriteDomains(FDD.Domains,Lines);
+      If (FDD.Sequences.Count>0) then
+        WriteSequences(FDD.Sequences,Lines);
+      For I:=0 to FDD.Tables.Count-1 do
+        begin
+        T:=FDD.Tables[i];
+        If DoTable(T) then
+          CreateTableCode(T,Lines);
+        end;
     Finally
       CreateFooter(Lines);
     end;

+ 59 - 59
packages/fcl-db/src/datadict/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/15]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/23]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -261,178 +261,178 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddsqlite3
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddsqlite3
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddodbc fpddsqlite3
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddodbc fpddsqlite3
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddsqlite3
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddsqlite3
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=fpdatadict fpdddbf fpddsqldb
+override TARGET_UNITS+=fpdatadict fpdddiff fpdddbf fpddsqldb
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=fpdatadict fpddfb fpddsqldb  fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd

+ 1 - 1
packages/fcl-db/src/datadict/Makefile.fpc

@@ -17,7 +17,7 @@ packages_wince=ibase mysql oracle sqlite odbc postgres
 packages_win64=sqlite odbc
 
 [target]
-units=fpdatadict fpdddbf fpddsqldb
+units=fpdatadict fpdddiff fpdddbf fpddsqldb
 units_linux=fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 units_freebsd=fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd
 units_darwin=fpddfb fpddmysql40 fpddmysql41 fpddmysql50 fpddodbc fpddpq fpddoracle fpddsqlite3 fpddregstd

+ 6 - 1
packages/fcl-db/src/datadict/buildd.lpi

@@ -24,7 +24,7 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <Units Count="13">
+    <Units Count="14">
       <Unit0>
         <Filename Value="buildd.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -90,6 +90,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="fpddregstd"/>
       </Unit12>
+      <Unit13>
+        <Filename Value="fpdddiff.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpdddiff"/>
+      </Unit13>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
packages/fcl-db/src/datadict/buildd.lpr

@@ -5,7 +5,7 @@ uses
   Classes
   { you can add units after this }, fpddsqldb, fpdatadict, fpdddbf, fpddfb,
   fpddmysql40, fpddmysql41, fpddmysql50, fpddpq, fpddodbc, fpddoracle,
-fpddsqlite3, fpddregstd;
+fpddsqlite3, fpddregstd, fpdddiff;
 
 begin
 end.

+ 928 - 32
packages/fcl-db/src/datadict/fpdatadict.pp

@@ -30,6 +30,11 @@ Type
 
   TFPDDFieldList = Class;
   TFPDDIndexList = Class;
+  TDDTableDef = Class;
+  TDDTableDefs = Class;
+  TDDFieldDefs = Class;
+  TDDDomainDef = Class;
+  TFPDataDictionary = Class;
 
   { TDDFieldDef }
 
@@ -43,6 +48,8 @@ Type
     FDefaultExpression: string;
     FDisplayLabel: string;
     FDisplayWidth: Longint;
+    FDomain: TDDDomainDef;
+    FDomainName: string;
     FFieldName: string;
     FFieldType: TFieldType;
     FHint: String;
@@ -52,18 +59,27 @@ Type
     FRequired: Boolean;
     FSize: Integer;
     FVisible: Boolean;
+    function GetDomainName: string;
     Function IsSizeStored : Boolean;
     Function IsPrecisionStored : Boolean;
+    procedure SetDomain(const AValue: TDDDomainDef);
+    procedure SetDomainName(const AValue: string);
   protected
     function GetSectionName: String; override;
     procedure SetSectionName(const Value: String); override;
   Public
     Constructor Create(ACollection : TCollection); override;
+    Function FieldDefs : TDDFieldDefs;
+    Function DataDictionary : TFPDataDictionary;
+    // Will return True if the field or the domain it is based on is required
+    Function FieldIsRequired : Boolean;
+    Procedure ResolveDomain(ErrorOnFail : Boolean);
     Procedure ImportFromField(F: TField; Existing : Boolean = True);
     Procedure ApplyToField(F : TField);
     Procedure Assign(Source : TPersistent);  override;
     Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
     Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
+    Property Domain : TDDDomainDef Read FDomain Write SetDomain;
   Published
     property FieldType : TFieldType Read FFieldType Write FFieldType;
     property AlignMent : TAlignMent Read FAlignMent write FAlignment default taLeftJustify;
@@ -74,6 +90,7 @@ Type
     property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
     property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
     property FieldName: string read FFieldName write FFieldName;
+    property DomainName: string read GetDomainName write SetDomainName;
     property Constraint: string read FConstraint write FConstraint;
     property ReadOnly: Boolean read FReadOnly write FReadOnly;
     property Required: Boolean read FRequired write FRequired;
@@ -83,24 +100,41 @@ Type
     Property Hint : String Read FHint Write FHint;
     Property ProviderFlags : TProviderFlags Read FProviderFlags Write FProviderFlags;
   end;
-  
-  { TDDFieldDefs }
 
-  TDDFieldDefs = Class(TIniCollection)
+  { TDDTableCollection }
+  TDDTableCollection = Class(TIniCollection)
   private
+    FTableDef : TDDTableDef;
     FTableName: String;
+    function GetTableName: String;
+  Protected
+    Procedure SetTableDef(ATableDef : TDDTableDef);
+    procedure SetTableName(const AValue: String); virtual;
+  Public
+    Function DataDictionary : TFPDataDictionary;
+    Property TableDef : TDDTableDef Read FTableDef;
+    Property TableName : String Read GetTableName Write SetTableName;
+  end;
+
+  { TDDFieldDefs }
+
+  TDDFieldDefs = Class(TDDTableCollection)
+  private
     function GetField(Index : Integer): TDDFieldDef;
     procedure SetField(Index : Integer; const AValue: TDDFieldDef);
-    procedure SetTableName(const AValue: String);
+  Protected
+    procedure SetTableName(const AValue: String); override;
   Public
-    Constructor Create(ATableName : String);
+    Constructor Create(ATableDef : TDDTableDef);
+    Constructor Create(ATableName : string);
+    Property TableDef : TDDTableDef Read FTableDef;
+    Property TableName : String Read GetTableName Write SetTableName;
     Function AddField(AFieldName: String = '') : TDDFieldDef;
     Function IndexOfField(AFieldName : String) : Integer;
     Function FindField(AFieldName : String) : TDDFieldDef;
     Function FieldByName(AFieldName : String) : TDDFieldDef;
     Procedure FillFieldList(Const AFieldNames: String; List : TFPDDFieldList);
     Property Fields[Index : Integer] : TDDFieldDef Read GetField Write SetField; default;
-    Property TableName : String Read FTableName Write SetTableName;
   end;
   
   { TDDIndexDef }
@@ -131,19 +165,60 @@ Type
   end;
   
   { TDDIndexDefs }
-
-  TDDIndexDefs = Class(TIniCollection)
+  TDDIndexDefs = Class(TDDTableCollection)
   private
-    FTableName : String;
     function GetIndex(Index : Integer): TDDIndexDef;
     procedure SetIndex(Index : Integer; const AValue: TDDIndexDef);
-    procedure SetTableName(const AValue: String);
+  Protected
+    procedure SetTableName(const AValue: String); override;
   Public
+    Constructor Create(ATableDef : TDDTableDef);
     Constructor Create(ATableName : String);
     Function AddDDIndexDef(AName : String) : TDDIndexDef;
-    Property TableName : String Read FTableName Write SetTableName;
+    function AddIndex (AName: String) : TDDIndexDef;
+    function IndexByName(AIndexName: String): TDDIndexDef;
+    function FindIndex(AIndexName: String): TDDIndexDef;
+    function IndexOfIndex(AIndexName: String): Integer;
     Property Indexes[Index : Integer] : TDDIndexDef Read GetIndex Write SetIndex; default;
   end;
+  
+  { TDDForeignKeyDef }
+  
+  TDDForeignKeyDef = Class(TIniCollectionItem)
+  private
+    FKeyFields: String;
+    FKeyName: String;
+    FReferencedFields: String;
+    FTableName: String;
+    procedure SetKeyName(const AValue: String);
+  protected
+    function GetSectionName: String; override;
+    procedure SetSectionName(const Value: String); override;
+    procedure Assign(ASource : TPersistent); override;
+  Public
+    Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
+    Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
+  Published
+    Property KeyName : String Read FKeyName Write SetKeyName;
+    Property ReferencesTable : String Read FTableName Write FTableName;
+    Property KeyFields : String Read FKeyFields Write FKeyFields;
+    Property ReferencedFields : String Read FReferencedFields Write FReferencedFields;
+  end;
+  
+  { TDDForeignKeyDefs }
+
+  TDDForeignKeyDefs = Class(TIniCollection)
+  private
+    FTableName: String;
+    function GetKey(AIndex : Integer): TDDForeignKeyDef;
+    procedure SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef);
+    procedure SetTableName(const AValue: String);
+  Public
+    Constructor Create(ATableName : String);
+    Function AddForeignKeyDef(AName : String) : TDDForeignKeyDef;
+    Property TableName : String Read FTableName Write SetTableName;
+    Property Indexes[AIndex : Integer] : TDDForeignKeyDef Read GetKey Write SetKey; default;
+  end;
 
   { TDDTableDef }
 
@@ -151,6 +226,7 @@ Type
   private
     FFieldDefs: TDDFieldDefs;
     FIndexDefs: TDDIndexDefs;
+    FKeyDefs: TDDForeignKeyDefs;
     FPrimaryKeyName: String;
     FTableName: String;
     function GetOnProgress: TDDProgressEvent;
@@ -162,6 +238,8 @@ Type
   Public
     Constructor Create(ACollection : TCollection); override;
     Destructor Destroy; override;
+    Function DataDictionary : TFPDataDictionary;
+    Function TableDefs : TDDTableDefs;
     Function ImportFromDataset(Dataset : TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
     Procedure ApplyToDataset(Dataset : TDataset);
     Function AddField(AFieldName : String = '') : TDDFieldDef;
@@ -169,6 +247,7 @@ Type
     Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
     Property Fields : TDDFieldDefs Read FFieldDefs;
     Property Indexes : TDDIndexDefs Read FIndexDefs;
+    Property ForeignKeys : TDDForeignKeyDefs Read FKeyDefs;
     Property OnProgress : TDDProgressEvent Read GetOnProgress;
   Published
     Property TableName : String Read FTableName Write SetTableName;
@@ -179,10 +258,12 @@ Type
 
   TDDTableDefs = Class(TIniCollection)
   private
+    FDataDictionary: TFPDataDictionary;
     FOnProgress: TDDProgressEvent;
     function GetTable(Index : Integer): TDDTableDef;
     procedure SetTable(Index : Integer; const AValue: TDDTableDef);
   Public
+    Property DataDictionary: TFPDataDictionary Read FDataDictionary;
     Function AddTable(ATableName : String = '') : TDDTableDef;
     Function IndexOfTable(ATableName : String) : Integer;
     Function FindTable(ATableName : String) : TDDTableDef;
@@ -191,6 +272,91 @@ Type
     Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
   end;
 
+  { TDDSequenceDef }
+
+  TDDSequenceDef = Class(TIniCollectionItem)
+  private
+    FIncrement: Integer;
+    FSequenceName: String;
+    FStartValue: Integer;
+    procedure SetSequenceName(const AValue: String);
+  protected
+    function GetSectionName: String; override;
+    procedure SetSectionName(const Value: String); override;
+    procedure Assign(ASource : TPersistent); override;
+  Public
+    Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
+    Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
+  Published
+    Property SequenceName : String Read FSequenceName Write SetSequenceName;
+    Property StartValue : Integer Read FStartValue Write FStartValue;
+    Property Increment : Integer Read FIncrement Write FIncrement;
+  end;
+
+  { TDDSequenceDefs }
+
+  TDDSequenceDefs = Class(TIniCollection)
+  private
+    FDataDictionary: TFPDataDictionary;
+    FOnProgress: TDDProgressEvent;
+    function GetSequence(Index : Integer): TDDSequenceDef;
+    procedure SetSequence(Index : Integer; const AValue: TDDSequenceDef);
+  Public
+    Constructor Create;
+    Function AddSequence(ASequenceName : String = '') : TDDSequenceDef;
+    Function IndexOfSequence(ASequenceName : String) : Integer;
+    Function FindSequence(ASequenceName : String) : TDDSequenceDef;
+    Function SequenceByName(ASequenceName : String) : TDDSequenceDef;
+    Property DataDictionary : TFPDataDictionary Read FDataDictionary;
+    Property Sequences[Index : Integer] : TDDSequenceDef Read GetSequence Write SetSequence; default;
+    Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
+  end;
+
+  { TDDDomainDef }
+
+  TDDDomainDef = Class(TIniCollectionItem)
+    procedure SetDomainName(const AValue: String);
+  private
+    FCheckConstraint: String;
+    FDomainName: String;
+    FFieldType: TFieldType;
+    FPrecision: Integer;
+    FRequired: Boolean;
+    FSize: Integer;
+  protected
+    function GetSectionName: String; override;
+    procedure SetSectionName(const Value: String); override;
+    procedure Assign(ASource : TPersistent); override;
+  Public
+    Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
+    Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
+  Published
+    Property DomainName : String Read FDomainName Write SetDomainName;
+    Property FieldType : TFieldType Read FFieldType Write FFieldType;
+    property Size : Integer Read FSize Write FSize;
+    property Precision : Integer Read FPrecision Write FPrecision;
+    Property Required : Boolean Read FRequired Write FRequired;
+    Property CheckConstraint : String Read FCheckConstraint Write FCheckConstraint;
+  end;
+
+  { TDDDomainDefs }
+
+  TDDDomainDefs = Class(TIniCollection)
+  private
+    FDataDictionary: TFPDataDictionary;
+    FOnProgress: TDDProgressEvent;
+    function GetDomain(Index : Integer): TDDDomainDef;
+    procedure SetDomain(Index : Integer; const AValue: TDDDomainDef);
+  Public
+    Constructor Create;
+    Property DataDictionary : TFPDataDictionary Read FDataDictionary;
+    Function AddDomain(ADomainName : String = '') : TDDDomainDef;
+    Function IndexOfDomain(ADomainName : String) : Integer;
+    Function FindDomain(ADomainName : String) : TDDDomainDef;
+    Function DomainByName(ADomainName : String) : TDDDomainDef;
+    Property Domains[Index : Integer] : TDDDomainDef Read GetDomain Write SetDomain; default;
+    Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
+  end;
 
   { TFPDataDictionary }
   TOnApplyDataDictEvent = Procedure (Sender : TObject; Source : TDDFieldDef; Dest : TField; Var Allow : Boolean) of object;
@@ -198,9 +364,11 @@ Type
   TFPDataDictionary = Class(TPersistent)
   private
     FDDName: String;
+    FDomains: TDDDomainDefs;
     FFileName: String;
     FOnApplyDataDictEvent: TOnApplyDataDictEvent;
     FOnProgress: TDDProgressEvent;
+    FSequences: TDDSequenceDefs;
     FTables: TDDTableDefs;
     // Last table that returned a match for findfieldDef
     FLastMatchTableDef : TDDTableDef;
@@ -219,6 +387,8 @@ Type
     function CanonicalizeFieldName(const InFN: String; Out TN, FN: String): Boolean;
     function CanonicalizeFieldName(const InFN: String; Out TableDef : TDDTableDef; Out FN: String): Boolean;
     Property Tables : TDDTableDefs Read FTables;
+    Property Sequences : TDDSequenceDefs Read FSequences;
+    Property Domains : TDDDomainDefs Read FDomains;
     Property FileName : String Read FFileName;
     Property Name : String Read FDDName Write FDDName;
     Property OnProgress : TDDProgressEvent Read FOnProgress Write SetOnProgress;
@@ -253,8 +423,28 @@ Type
   end;
 
   
+  { TFPDDSequenceList }
+
+  TFPDDSequenceList = Class(TObjectList)
+  private
+    function GetSequenceDef(AIndex : Integer): TDDSequenceDef;
+    procedure SetSequenceDef(AIndex : Integer; const AValue: TDDSequenceDef);
+  Public
+    Constructor CreateFromSequenceDefs(SD : TDDSequenceDefs);
+    Property SequenceDefs[AIndex : Integer] : TDDSequenceDef Read GetSequenceDef Write SetSequenceDef; default;
+  end;
+
+  { TFPDDDomainList }
+
+  TFPDDDomainList = Class(TObjectList)
+  private
+    function GetDomainDef(AIndex : Integer): TDDDomainDef;
+    procedure SetDomainDef(AIndex : Integer; const AValue: TDDDomainDef);
+  Public
+    Constructor CreateFromDomainDefs(DD : TDDDomainDefs);
+    Property DomainDefs[AIndex : Integer] : TDDDomainDef Read GetDomainDef Write SetDomainDef; default;
+  end;
 
-  
   { TFPDDSQLEngine }
   TSQLEngineOption = (eoLineFeedAfterField,eoUseOldInWhereParams,eoAndTermsInBrackets,eoQuoteFieldNames,eoLineFeedAfterAndTerm,eoAddTerminator);
   TSQLEngineOptions = Set of TSQLEngineOption;
@@ -269,7 +459,6 @@ Type
     FOptions: TSQLEngineOptions;
     FTableDef: TDDTableDef;
     FNoIndent : Boolean;
-    FTerminator: String;
     FTerminatorChar : Char;
   Protected
     procedure CheckTableDef;
@@ -285,7 +474,8 @@ Type
     Function FieldNameString(FD : TDDFieldDef) : string; virtual;
     Function TableNameString(TD : TDDTableDef) : string; virtual;
     Function FieldParamString(FD : TDDFieldDef; UseOldParam : Boolean) : string; virtual;
-    Function FieldTypeString(FD : TDDFieldDef) : String; virtual;
+    Function FieldTypeString(ft : TFieldType; ASize,APrecision : Integer) : String; virtual;
+    Function FieldTypeString(FD : TDDFieldDef) : String;
     Function FieldDefaultString(FD : TDDFieldDef) : String; virtual;
     Function FieldCheckString(FD : TDDFieldDef) : String; virtual;
     Function FieldDeclarationString(FD : TDDFieldDef) : String; virtual;
@@ -301,15 +491,27 @@ Type
     Procedure CreateCreateSQLStrings(Fields,KeyFields : TFPDDFieldList; SQL : TStrings);
     Procedure CreateCreateSQLStrings(KeyFields : TFPDDFieldList; SQL : TStrings);
     Procedure CreateIndexesSQLStrings(Indexes : TFPDDIndexList; SQL : TStrings);
+    Procedure CreateSequencesSQLStrings(Sequences : TFPDDSequenceList; SQL : TStrings);
+    Procedure CreateDomainsSQLStrings(Domains : TFPDDDomainList; SQL : TStrings);
     Function  CreateSelectSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
     Function  CreateInsertSQL(FieldList : TFPDDFieldList) : String; virtual;
     Function  CreateUpdateSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
     Function  CreateDeleteSQL(KeyFields : TFPDDFieldList) : String; virtual;
     Function  CreateCreateSQL(Fields,KeyFields : TFPDDFieldList) : String; virtual;
     Function  CreateCreateSQL(KeyFields : TFPDDFieldList) : String; virtual;
+    // Indexes
     Function  CreateIndexSQL(Index : TDDIndexDef) : String; virtual;
     Function  CreateIndexesSQL(Indexes : TFPDDIndexList) : String;
     Function  CreateIndexesSQL(Indexes : TDDIndexDefs) : String;
+    // Sequences
+    Function  CreateSequenceSQL(Sequence : TDDSequenceDef) : String; virtual;
+    Function  CreateSequencesSQL(Sequences : TFPDDSequenceList) : String;
+    Function  CreateSequencesSQL(Sequences : TDDSequenceDefs) : String;
+    // Domains
+    Function  CreateDomainSQL(Domain : TDDDomainDef) : String; virtual;
+    Function  CreateDomainsSQL(Domains : TFPDDDomainList) : String;
+    Function  CreateDomainsSQL(Domains : TDDDomainDefs) : String;
+    // Convenience calls
     Function  CreateTableSQL : String;
     Procedure CreateTableSQLStrings(SQL : TStrings);
     Property TableDef : TDDTableDef Read FTableDef Write FTableDef;
@@ -320,7 +522,8 @@ Type
   end;
   
   { TFPDDEngine }
-  TFPDDEngineCapability =(ecImport,ecCreateTable,ecViewTable, ecTableIndexes, ecRunQuery, ecRowsAffected);
+  TFPDDEngineCapability =(ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
+                          ecRunQuery, ecRowsAffected, ecSequences, ecDomains);
   TFPDDEngineCapabilities = set of TFPDDEngineCapability;
   {
     to avoid dependencies on GUI elements in the data dictionary engines,
@@ -351,6 +554,8 @@ Type
     Procedure Disconnect ; virtual; abstract;
     Function GetTableList(List : TStrings) : Integer; virtual; abstract;
     Function ImportFields(Table : TDDTableDef) : Integer; virtual; abstract;
+    Function ImportDomains(Domains : TDDDomainDefs) : Integer; virtual;
+    Function ImportSequences(Sequences : TDDSequenceDefs) : Integer; virtual;
     // Override depending on capabilities
     Procedure CreateTable(Table : TDDTableDef); virtual;
     // Should not open the dataset.
@@ -417,7 +622,6 @@ Const
   
   // Fields Saving
   SFieldSuffix              = '_Fields';
-  SIndexSuffix              = '_Indices';
   KeyAlignMent              = 'AlignMent';
   KeyCustomConstraint       = 'CustomConstraint';
   KeyConstraintErrorMessage = 'ConstraintErrorMessage';
@@ -426,6 +630,7 @@ Const
   KeyDisplayLabel           = 'DisplayLabel';
   KeyDisplayWidth           = 'DisplayWidth';
   KeyFieldName              = 'FieldName';
+  KeyDomainName             = 'DomainName';
   KeyConstraint             = 'Constraint';
   KeyReadOnly               = 'ReadOnly';
   KeyRequired               = 'Required';
@@ -437,12 +642,29 @@ Const
   KeyProviderFlags          = 'Providerflags';
   
   // Index saving
+  SIndexSuffix              = '_Indices';
   KeyExpression             = 'Expression';
   KeyFields                 = 'Fields';
   KeyCaseInsFields          = 'CaseInsFields';
   KeyDescFields             = 'DescFields';
   KeySource                 = 'Source';
   KeyOptions                = 'Options';
+  
+  // Foreign key Saving
+  SKeySuffix                = '_FOREIGNKEYS';
+  KeyKeyFields              = 'KeyFields';
+  KeyKeyName                = 'KeyName';
+  KeyReferencesTable        = 'ReferencesTable';
+  KeyReferencedFields       = 'ReferencedFields';
+
+  // Sequence saving
+  SDatadictSequences        = SDataDict+'_Sequences';
+  KeyStartValue             = 'StartValue';
+  KeyIncrement              = 'Increment';
+
+  // Domain saving
+  SDataDictDomains          = SDataDict+'_Domains';
+  KeyCheckConstraint        = 'Constraint';
 
   // SQL Keywords
   SSelect      = 'SELECT';
@@ -477,6 +699,7 @@ Const
 
 Resourcestring
   SErrFieldNotFound           = '"%s": Field "%s" not found.';
+  SErrIndexNotFound           = '"%s": Index "%s" not found.';
   SErrTableNotFound           = 'Table "%s" not found.';
   SErrDuplicateTableName      = 'Duplicate table name: "%s"';
   SErrDuplicateFieldName      = '"%s": Duplicate field name: "%s"';
@@ -508,7 +731,13 @@ Resourcestring
   SIndexOptionNonMaintained   = 'Not maintained';
   SWarnFieldNotFound          = 'Could not find field "%s".';
   SLogFieldFoundIn            = 'Field "%s" found in table "%s".';
-  
+  SErrSequenceNotFound        = 'Sequence "%s" not found.';
+  SErrDuplicateSequence       = 'Duplicate sequence name: "%s"';
+  SErrDuplicateDomain         = 'Duplicate domain name: "%s"';
+  SErrDomainNotFound          = 'Domain "%s" not found.';
+  SErrNoDataDict              = '%s : No data dictionary available';
+  SErrResolveDomain           = 'Cannot resolve domain';
+
 Const
   IndexOptionNames : Array [TIndexOption] of String
                    = (SIndexOptionPrimary, SIndexOptionUnique,
@@ -720,11 +949,34 @@ begin
     ftWideString,ftArray, ftOraBlob, ftOraClob, ftFMTBcd];
 end;
 
+function TDDFieldDef.GetDomainName: string;
+begin
+  If Assigned(FDomain) then
+    Result:=FDomain.DomainName
+  else // Not resolved yet
+    Result:=FDomainName;
+end;
+
 function TDDFieldDef.IsPrecisionStored: Boolean;
 begin
   Result:=FieldType in [ftFloat,ftBCD,ftFMTBCD];
 end;
 
+procedure TDDFieldDef.SetDomain(const AValue: TDDDomainDef);
+begin
+  if FDomain=AValue then exit;
+  FDomain:=AValue;
+  If Assigned(FDomain) then
+    FDomainName:=FDomain.DomainName;
+end;
+
+procedure TDDFieldDef.SetDomainName(const AValue: string);
+begin
+  FDomainName:=AValue;
+  If (AValue<>'') then
+    ResolveDomain(False);
+end;
+
 function TDDFieldDef.GetSectionName: String;
 begin
   Result:=FFieldName;
@@ -742,6 +994,52 @@ begin
   FAlignMent:=taLeftJustify;
 end;
 
+function TDDFieldDef.FieldDefs: TDDFieldDefs;
+begin
+  Result:=(Collection as TDDFieldDefs)
+end;
+
+function TDDFieldDef.DataDictionary: TFPDataDictionary;
+begin
+  If Assigned(FieldDefs) then
+    Result:=FieldDefs.DataDictionary
+  else
+    Result:=Nil;
+end;
+
+function TDDFieldDef.FieldIsRequired: Boolean;
+begin
+  Result:=Required;
+  If (Not Result) and (DomainName<>'') then
+    begin
+    ResolveDomain(True);
+    Result:=Domain.Required;
+    end;
+end;
+
+procedure TDDFieldDef.ResolveDomain(ErrorOnFail : Boolean);
+
+Var
+  DD : TFPDataDictionary;
+
+begin
+  If (FDomainName<>'') then
+    Exit;
+  DD:=DataDictionary;
+  If Not Assigned(DD) then
+    begin
+    If ErrorOnFail then
+      Raise EDataDict.CreateFmt(SErrNoDataDict,[SErrResolveDomain]);
+    end
+  else if (Not Assigned(FDomain)) or (CompareText(FDomain.DomainName,FDomainName)<>0) then
+    begin
+    If ErrorOnFail then
+      FDomain:=DD.Domains.DomainByName(FDomainName)
+    else
+      FDomain:=DD.Domains.FindDomain(FDomainName);
+    end;
+end;
+
 procedure TDDFieldDef.ImportFromField(F: TField; Existing : Boolean = True);
 begin
   FieldName:=F.FieldName;
@@ -812,6 +1110,7 @@ begin
     DBDefault:=DF.DBDefault;
     DisplayLabel:=DisplayLabel;
     FieldName:=DF.FieldName;
+    DomainName:=DF.DomainName;
     Constraint:=DF.Constraint;
     Hint:=DF.Hint;
     ReadOnly:=DF.ReadOnly;
@@ -845,6 +1144,7 @@ begin
     WriteString(ASection,KeyDBDefault,DBDefault);
     WriteString(ASection,KeyDisplayLabel,DisplayLabel);
     WriteString(ASection,KeyFieldName,FieldName);
+    WriteString(ASection,KeyDomainName,DomainName);
     WriteString(ASection,KeyConstraint,Constraint);
     WriteString(ASection,KeyHint,Hint);
     O:=Integer(ProviderFlags);
@@ -880,6 +1180,7 @@ begin
     DBDefault:=ReadString(ASection,KeyDBDefault,DBDefault);
     DisplayLabel:=ReadString(ASection,KeyDisplayLabel,DisplayLabel);
     FieldName:=ReadString(ASection,KeyFieldName,FieldName);
+    DomainName:=ReadString(ASection,KeyDomainName,DomainName);
     Constraint:=ReadString(ASection,KeyConstraint,Constraint);
     Hint:=ReadString(ASection,KeyHint,Hint);
     S:=ReadString(ASection,KeyProviderFlags,'');
@@ -899,27 +1200,36 @@ end;
 
 procedure TDDFieldDefs.SetTableName(const AValue: String);
 begin
-  FTableName:=AValue;
+  Inherited;
   FSectionPrefix:=AValue;
   GlobalSection:=AValue+SFieldSuffix;
 end;
 
+constructor TDDFieldDefs.Create(ATableDef: TDDTableDef);
+begin
+  Inherited Create(TDDFieldDef);
+  FPrefix:='Field';
+  SetTableDef(ATableDef);
+end;
+
+constructor TDDFieldDefs.Create(ATableName: String);
+begin
+  Inherited Create(TDDFieldDef);
+  FPrefix:='Field';
+  TableName:=ATableName;
+end;
+
 function TDDFieldDefs.GetField(Index : Integer): TDDFieldDef;
 begin
   Result:=TDDFieldDef(Items[Index]);
 end;
 
+
 procedure TDDFieldDefs.SetField(Index : Integer; const AValue: TDDFieldDef);
 begin
   Items[Index]:=AValue;
 end;
 
-constructor TDDFieldDefs.Create(ATableName: String);
-begin
-  Inherited Create(TDDFieldDef);
-  FPrefix:='Field';
-  TableName:=ATableName;
-end;
 
 function TDDFieldDefs.AddField(AFieldName: String): TDDFieldDef;
 
@@ -997,6 +1307,7 @@ procedure TDDTableDef.SetTableName(const AValue: String);
 begin
   FTableName:=AValue;
   FFieldDefs.TableName:=AValue;
+  FIndexDefs.TableName:=AValue;
 end;
 
 function TDDTableDef.GetPrimaryKeyName: String;
@@ -1024,18 +1335,33 @@ end;
 constructor TDDTableDef.Create(ACollection: TCollection);
 begin
   inherited Create(ACollection);
-  FFieldDefs:=TDDFieldDefs.Create('NewTable');
-  FIndexDefs:=TDDIndexDefs.Create('NewTable');
+  FFieldDefs:=TDDFieldDefs.Create(Self);
+  FIndexDefs:=TDDIndexDefs.Create(Self);
+  FKeyDefs:=TDDForeignkeyDefs.Create('NewTable');
 end;
 
 destructor TDDTableDef.Destroy;
 
 begin
+  FreeAndNil(FKeyDefs);
   FreeAndNil(FFieldDefs);
   FreeAndNil(FIndexDefs);
   inherited Destroy;
 end;
 
+function TDDTableDef.DataDictionary: TFPDataDictionary;
+begin
+  If Assigned(TableDefs) then
+    Result:=TableDefs.DataDictionary
+  else
+    Result:=Nil;
+end;
+
+function TDDTableDef.TableDefs: TDDTableDefs;
+begin
+  Result:=TDDTableDefs(Collection);
+end;
+
 Function TDDTableDef.ImportFromDataset(Dataset: TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
 
 Var
@@ -1132,6 +1458,7 @@ begin
   Items[Index]:=AValue;
 end;
 
+
 function TDDTableDefs.AddTable(ATableName: String): TDDTableDef;
 
 Var
@@ -1192,10 +1519,16 @@ end;
 constructor TFPDataDictionary.Create;
 begin
   FTables:=TDDTableDefs.Create(TDDTableDef);
+  FTables.FDataDictionary:=Self;
+  FSequences:=TDDSequenceDefs.Create;
+  FSequences.FDataDictionary:=Self;
+  FDomains:=TDDDomainDefs.Create;
+  FDomains.FDataDictionary:=Self;
 end;
 
 destructor TFPDataDictionary.Destroy;
 begin
+  FreeAndNil(FSequences);
   FreeAndNil(FTables);
   inherited Destroy;
 end;
@@ -1230,6 +1563,8 @@ end;
 procedure TFPDataDictionary.SaveToIni(Ini: TCustomIniFile; ASection: String);
 begin
   Ini.WriteString(ASection,KeyDataDictName,Name);
+  FDomains.SaveToIni(Ini,SDatadictDomains);
+  FSequences.SaveToIni(Ini,SDatadictSequences);
   FTables.SaveToIni(Ini,SDatadictTables);
 end;
 
@@ -1256,6 +1591,10 @@ end;
 procedure TFPDataDictionary.LoadFromIni(Ini: TCustomIniFile; ASection: String);
 begin
   FDDName:=Ini.ReadString(ASection,KeyDataDictName,'');
+  FDomains.Clear;
+  FDomains.LoadFromIni(Ini,SDataDictDomains);
+  FSequences.Clear;
+  FSequences.LoadFromIni(Ini,SDataDictSequences);
   FTables.Clear;
   FTables.LoadFromIni(Ini,SDataDictTables);
 end;
@@ -1457,6 +1796,16 @@ begin
   Result:=[];
 end;
 
+function TFPDDEngine.ImportDomains(Domains: TDDDomainDefs): Integer;
+begin
+  Domains.Clear;
+end;
+
+function TFPDDEngine.ImportSequences(Sequences: TDDSequenceDefs): Integer;
+begin
+  Sequences.Clear;
+end;
+
 procedure TFPDDEngine.CreateTable(Table: TDDTableDef);
 begin
   Raise EDataDict.CreateFmt(SErrCreateTableNotSupported,[DBType]);
@@ -1635,6 +1984,13 @@ begin
 end;
 
 function TFPDDSQLEngine.FieldTypeString(FD : TDDFieldDef) : String;
+
+begin
+  Result:=FieldTypeString(FD.FieldType,FD.Size,FD.Precision);
+end;
+
+
+Function TFPDDSQLEngine.FieldTypeString(FT : TFieldType; ASize,APrecision : Integer) : String;
 {
 ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
@@ -1644,17 +2000,17 @@ ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
     ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
     ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd}
 begin
-  Result:=SQLFieldTypes[fD.FieldType];
+  Result:=SQLFieldTypes[FT];
   If (Result='') then
-    Raise EDataDict.CreateFmt(SErrFieldTypeNotSupported,[GetEnumName(TypeInfo(TFieldType),Ord(FD.FieldType))]);
-  case FD.FieldType of
+    Raise EDataDict.CreateFmt(SErrFieldTypeNotSupported,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
+  case FT of
     ftString,
     ftFixedChar,
     ftWideString :
-      Result:=Result+Format('(%d)',[FD.Size]);
+      Result:=Result+Format('(%d)',[ASize]);
     ftBCD,
     ftFMTBCD :
-      Result:=Result+Format('(%d,%d)',[FD.Size,FD.Precision]);
+      Result:=Result+Format('(%d,%d)',[APrecision,ASize]);
   end;
 end;
 
@@ -1925,6 +2281,84 @@ begin
   end;
 end;
 
+function TFPDDSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): String;
+begin
+  Result:='CREATE SEQUENCE '+Sequence.SequenceName;
+  If (Sequence.StartValue>0) then
+    Result:=Result+'START WITH '+IntToStr(Sequence.StartValue);
+  If (Sequence.Increment<>0) then
+    Result:=Result+'INCREMENT BY '+IntToStr(Sequence.Increment);
+end;
+
+function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TFPDDSequenceList): String;
+
+Var
+  SQL : TStrings;
+
+begin
+  SQL:=TStringList.Create;
+  Try
+    CreateSequencesSQLStrings(Sequences,SQL);
+    Result:=SQL.Text;
+  Finally
+    SQL.Free;
+  end;
+end;
+
+function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TDDSequenceDefs): String;
+
+Var
+  L : TFPDDSequenceList;
+
+begin
+  L:=TFPDDSequenceList.CreateFromSequenceDefs(Sequences);
+  try
+    L.OwnsObjects:=False;
+    Result:=CreateSequencesSQl(L);
+  finally
+    L.Free;
+  end;
+end;
+
+function TFPDDSQLEngine.CreateDomainSQL(Domain: TDDDomainDef): String;
+begin
+  Result:='CREATE DOMAIN '+Domain.DomainName+' ';
+  Result:=Result+FieldTypeString(Domain.FieldType,Domain.Size,Domain.Precision);
+  If Domain.Required then
+    Result:=Result+' NOT NULL';
+  If (Domain.CheckConstraint<>'') then
+    Result:=Result+' CHECK ('+Domain.CheckConstraint+')';
+end;
+
+function TFPDDSQLEngine.CreateDomainsSQL(Domains: TFPDDDomainList): String;
+
+Var
+  SQL : TStrings;
+
+begin
+  SQL:=TStringList.Create;
+  Try
+    CreateDomainsSQLStrings(Domains,SQL);
+    Result:=SQL.Text;
+  Finally
+    SQL.Free;
+  end;
+end;
+
+function TFPDDSQLEngine.CreateDomainsSQL(Domains: TDDDomainDefs): String;
+Var
+  L : TFPDDDomainList;
+
+begin
+  L:=TFPDDDomainList.CreateFromDomainDefs(Domains);
+  try
+    L.OwnsObjects:=False;
+    Result:=CreateDomainsSQl(L);
+  finally
+    L.Free;
+  end;
+end;
+
 function TFPDDSQLEngine.CreateTableSQL: String;
 
 Var
@@ -2029,6 +2463,28 @@ begin
     SQL.Add(CreateIndexSQL(Indexes[i])+TerminatorChar);
 end;
 
+procedure TFPDDSQLEngine.CreateSequencesSQLStrings(Sequences: TFPDDSequenceList;
+  SQL: TStrings);
+
+Var
+  I : integer;
+
+begin
+  For I:=0 to Sequences.Count-1 do
+    SQL.Add(CreateSequenceSQL(Sequences[i])+TerminatorChar);
+end;
+
+procedure TFPDDSQLEngine.CreateDomainsSQLStrings(Domains: TFPDDDomainList;
+  SQL: TStrings);
+
+Var
+  I : integer;
+
+begin
+  For I:=0 to Domains.Count-1 do
+    SQL.Add(CreateDomainSQL(Domains[i])+TerminatorChar);
+end;
+
 { ---------------------------------------------------------------------
   TDDFieldList
   ---------------------------------------------------------------------}
@@ -2186,11 +2642,20 @@ end;
 
 procedure TDDIndexDefs.SetTableName(const AValue: String);
 begin
-  FTableName:=AValue;
+  Inherited;
   FSectionPrefix:=AValue;
   GlobalSection:=AValue+SIndexSuffix;
 end;
 
+constructor TDDIndexDefs.Create(ATableDef: TDDTableDef);
+begin
+  FTableDef:=ATableDef;
+  If Assigned(FTableDef) then
+    Create(FTableDef.TableName)
+  else
+    Create('')
+end;
+
 constructor TDDIndexDefs.Create(ATableName: String);
 begin
   FPrefix:='Index';
@@ -2199,11 +2664,442 @@ begin
 end;
 
 function TDDIndexDefs.AddDDIndexDef(AName: String): TDDIndexDef;
+begin
+  result := AddIndex (AName);
+end;
+
+function TDDIndexDefs.AddIndex(AName: String): TDDIndexDef;
 begin
   Result:=Add as TDDIndexDef;
   Result.IndexName:=AName;
 end;
 
+{ TDDForeignKeyDef }
+
+procedure TDDForeignKeyDef.SetKeyName(const AValue: String);
+begin
+  if FKeyName=AValue then exit;
+
+  FKeyName:=AValue;
+end;
+
+function TDDForeignKeyDef.GetSectionName: String;
+begin
+  Result:=FKeyName;
+end;
+
+procedure TDDForeignKeyDef.SetSectionName(const Value: String);
+begin
+  FkeyName:=Value;
+end;
+
+procedure TDDForeignKeyDef.Assign(ASource: TPersistent);
+
+Var
+  K : TDDForeignKeyDef;
+
+begin
+  if ASource is TDDForeignKeyDef then
+    begin
+    K:=ASource as TDDForeignKeyDef;
+    FKeyFields:=K.KeyFields;
+    FKeyName:=K.KeyName;
+    FReferencedFields:=K.ReferencedFields;
+    FTableName:=K.FTableName;
+    end
+  else
+    inherited Assign(ASource);
+end;
+
+procedure TDDForeignKeyDef.SaveToIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini Do
+    begin
+    WriteString(ASection,KeyKeyFields,KeyFields);
+    WriteString(ASection,KeyKeyName,KeyName);
+    WriteString(ASection,KeyReferencesTable,ReferencesTable);
+    WriteString(ASection,KeyReferencedFields,ReferencedFields);
+    end;
+end;
+
+procedure TDDForeignKeyDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini Do
+    begin
+    KeyFields:=ReadString(ASection,KeyKeyFields,'');
+    KeyName:=ReadString(ASection,KeyKeyName,'');
+    ReferencesTable:=ReadString(ASection,KeyReferencesTable,'');
+    ReferencedFields:=ReadString(ASection,KeyReferencedFields,'');
+    end;
+end;
+
+{ TDDForeignKeyDefs }
+
+function TDDForeignKeyDefs.GetKey(AIndex : Integer): TDDForeignKeyDef;
+begin
+  Result:=TDDForeignKeyDef(Items[AIndex]);
+end;
+
+procedure TDDForeignKeyDefs.SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef
+  );
+begin
+  Items[AIndex]:=AValue
+end;
+
+procedure TDDForeignKeyDefs.SetTableName(const AValue: String);
+begin
+  if FTableName=AValue then exit;
+  FSectionPrefix:=AValue;
+  GlobalSection:=AValue+SKeySuffix;
+end;
+
+constructor TDDForeignKeyDefs.Create(ATableName: String);
+begin
+  Inherited Create(TDDForeignKeyDef);
+  FPrefix:='Key';
+  SetTableName(ATAbleName);
+end;
+
+function TDDForeignKeyDefs.AddForeignKeyDef(AName: String): TDDForeignKeyDef;
+begin
+  Result:=Add as TDDForeignKeyDef;
+  Result.KeyName:=AName;
+end;
+
+function TDDIndexDefs.IndexOfIndex(AIndexName: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (CompareText(GetIndex(Result).IndexName,AIndexName)<>0) do
+    Dec(Result)
+end;
+
+function TDDIndexDefs.FindIndex(AIndexName: String): TDDIndexDef;
+Var
+  I : integer;
+begin
+  I:=IndexOfIndex(AIndexName);
+  If (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetIndex(I);
+end;
+
+function TDDIndexDefs.IndexByName(AIndexName: String): TDDIndexDef;
+begin
+  Result:=FindIndex(AIndexName);
+  If Result=Nil then
+    Raise EDatadict.CreateFmt(SErrIndexNotFound,[TableName,AIndexName]);
+end;
+
+{ TDDDomainDefs }
+
+function TDDDomainDefs.GetDomain(Index: Integer): TDDDomainDef;
+begin
+  Result:=TDDDomainDef(Items[Index]);
+end;
+
+procedure TDDDomainDefs.SetDomain(Index: Integer;
+  const AValue: TDDDomainDef);
+begin
+  Items[Index]:=AValue;
+end;
+
+constructor TDDDomainDefs.Create;
+begin
+  FPrefix:='Domain';
+  FSectionPrefix:='Domain';
+  GlobalSection:='Domains';
+  inherited Create(TDDDomainDef);
+end;
+
+
+function TDDDomainDefs.AddDomain(ADomainName: String): TDDDomainDef;
+begin
+  Result:=Add as TDDDomainDef;
+  Result.DomainName:=ADomainName;
+end;
+
+function TDDDomainDefs.IndexOfDomain(ADomainName: String): Integer;
+
+begin
+  Result:=Count-1;
+  While (Result>=0) and (CompareText(GetDomain(Result).DomainName,ADomainName)=0) do
+    Dec(Result);
+end;
+
+function TDDDomainDefs.FindDomain(ADomainName: String): TDDDomainDef;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfDomain(ADomainName);
+  If (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetDomain(I);
+end;
+
+function TDDDomainDefs.DomainByName(ADomainName: String): TDDDomainDef;
+begin
+  Result:=FindDomain(ADomainName);
+  If (Result=Nil) then
+    Raise EDatadict.CreateFmt(SErrDomainNotFound,[ADomainName]);
+end;
+
+{ TDDDomainDef }
+
+procedure TDDDomainDef.SetDomainName(const AValue: String);
+begin
+  if FDomainName=AValue then exit;
+  If Assigned(Collection) and
+     ((Collection as TDDDomainDefs).FindDomain(AValue)<>Nil) then
+     EDataDict.CreateFmt(SErrDuplicateDomain,[AValue]);
+  FDomainName:=AValue;
+end;
+
+function TDDDomainDef.GetSectionName: String;
+begin
+  Result:=FDomainName;
+end;
+
+procedure TDDDomainDef.SetSectionName(const Value: String);
+begin
+  FDomainName:=Value;
+end;
+
+procedure TDDDomainDef.Assign(ASource: TPersistent);
+
+Var
+  D : TDDDomainDef;
+
+begin
+  if (ASource is TDDDomainDef) then
+    begin
+    D:=(ASource as TDDDomainDef);
+    FDomainName:=D.DomainName;
+    FFieldType:=D.FieldType;
+    FCheckconstraint:=D.Checkconstraint;
+    FSize:=D.Size;
+    FPrecision:=D.Precision;
+    end
+  else
+    inherited Assign(ASource);
+end;
+
+procedure TDDDomainDef.SaveToIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini do
+    begin
+    WriteInteger(ASection,KeyFieldType,Ord(Fieldtype));
+    WriteBool(ASection,KeyRequired,Required);
+    WriteString(ASection,KeyCheckConstraint,CheckConstraint);
+    WriteInteger(ASection,KeySize,Size);
+    WriteInteger(ASection,KeyPrecision,Precision);
+    end;
+end;
+
+procedure TDDDomainDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini do
+    begin
+    FieldType:=TFieldType(ReadInteger(ASection,KeyFieldType,Ord(Fieldtype)));
+    Required:=ReadBool(ASection,KeyRequired,Required);
+    CheckConstraint:=ReadString(ASection,KeyCheckConstraint,CheckConstraint);
+    Size:=ReadInteger(ASection,KeySize,Size);
+    Precision:=ReadInteger(ASection,KeyPrecision,Precision);
+    end;
+end;
+
+{ TFPDDDomainList }
+
+function TFPDDDomainList.GetDomainDef(AIndex: Integer): TDDDomainDef;
+begin
+  Result:=TDDDomainDef(Items[AIndex]);
+end;
+
+procedure TFPDDDomainList.SetDomainDef(AIndex: Integer;
+  const AValue: TDDDomainDef);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+constructor TFPDDDomainList.CreateFromDomainDefs(DD: TDDDomainDefs);
+
+Var
+  I : Integer;
+
+begin
+  Inherited Create;
+  For I:=0 to DD.Count-1 do
+    Add(DD[I]);
+end;
+
+{ TDDSequenceDef }
+
+procedure TDDSequenceDef.SetSequenceName(const AValue: String);
+begin
+  if FSequenceName=AValue then exit;
+  If Assigned(Collection) and
+     ((Collection as TDDSequenceDefs).FindSequence(AValue)<>Nil) then
+     EDataDict.CreateFmt(SErrDuplicateSequence,[AValue]);
+  FSequenceName:=AValue;
+end;
+
+function TDDSequenceDef.GetSectionName: String;
+begin
+  Result:=SequenceName;
+end;
+
+procedure TDDSequenceDef.SetSectionName(const Value: String);
+begin
+  SequenceName:=Value;
+end;
+
+procedure TDDSequenceDef.Assign(ASource: TPersistent);
+
+Var
+  S : TDDSequenceDef;
+
+begin
+  If ASource is TDDSequenceDef then
+    begin
+    S:=ASource as TDDSequenceDef;
+    FSequenceName:=S.SequenceName;
+    FStartvalue:=S.Startvalue;
+    FIncrement:=S.Increment;
+    end
+  else
+    inherited Assign(ASource);
+end;
+
+procedure TDDSequenceDef.SaveToIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini do
+    begin
+    WriteInteger(ASection,KeyStartValue,StartValue);
+    WriteInteger(ASection,KeyIncrement,StartValue);
+    end;
+end;
+
+procedure TDDSequenceDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
+begin
+  With Ini do
+    begin
+    StartValue:=ReadInteger(ASection,KeyStartValue,0);
+    Increment:=ReadInteger(ASection,KeyIncrement,0);
+    end;
+end;
+
+{ TDDSequenceDefs }
+
+function TDDSequenceDefs.GetSequence(Index: Integer): TDDSequenceDef;
+begin
+  Result:=TDDSequenceDef(Items[Index]);
+end;
+
+procedure TDDSequenceDefs.SetSequence(Index: Integer; const AValue: TDDSequenceDef);
+begin
+  Items[Index]:=AValue;
+end;
+
+constructor TDDSequenceDefs.Create;
+begin
+  FPrefix:='Sequence';
+  FSectionPrefix:='Sequence';
+  GlobalSection:='Sequences';
+  Inherited Create(TDDSequenceDef);
+end;
+
+function TDDSequenceDefs.AddSequence(ASequenceName: String): TDDSequenceDef;
+begin
+  Result:=Add as TDDSequenceDef;
+  Result.SequenceName:=ASequenceName;
+end;
+
+function TDDSequenceDefs.IndexOfSequence(ASequenceName: String): Integer;
+begin
+  While (Result>=0) and (CompareText(GetSequence(Result).SequenceName,ASequenceName)=0) do
+    Dec(Result);
+end;
+
+function TDDSequenceDefs.FindSequence(ASequenceName: String): TDDSequenceDef;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfSequence(ASequenceName);
+  If (I=-1) then
+    Result:=Nil
+  else
+    Result:=GetSequence(I);
+end;
+
+function TDDSequenceDefs.SequenceByName(ASequenceName: String): TDDSequenceDef;
+begin
+  Result:=FindSequence(ASequenceName);
+  If (Result=Nil) then
+    Raise EDatadict.CreateFmt(SErrSequenceNotFound,[ASequenceName]);
+end;
+
+
+{ TFPDDSequenceList }
+
+function TFPDDSequenceList.GetSequenceDef(AIndex: Integer): TDDSequenceDef;
+begin
+  Result:=TDDSequenceDef(Items[AIndex]);
+end;
+
+procedure TFPDDSequenceList.SetSequenceDef(AIndex: Integer;
+  const AValue: TDDSequenceDef);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+constructor TFPDDSequenceList.CreateFromSequenceDefs(SD: TDDSequenceDefs);
+
+Var
+  I : Integer;
+
+begin
+  Inherited Create;
+  For I:=0 to SD.Count-1 do
+    Add(SD[I]);
+end;
+
+
+{ TDDTableCollection }
+
+function TDDTableCollection.GetTableName: String;
+begin
+  If Assigned(FTableDef) then
+    Result:=FTableDef.TableName
+  else
+    Result:=FTableName;
+end;
+
+procedure TDDTableCollection.SetTableDef(ATableDef: TDDTableDef);
+begin
+  FTableDef:=ATableDef;
+  If Assigned(FTableDef) then
+    TableName:=FTableDef.TableName;
+end;
+
+procedure TDDTableCollection.SetTableName(const AValue: String);
+begin
+  FTableName:=AValue;
+end;
+
+
+function TDDTableCollection.DataDictionary: TFPDataDictionary;
+begin
+  If Assigned(FTableDef) then
+    Result:=FTableDef.DataDictionary
+  else
+    Result:=Nil;
+end;
+
 initialization
 
 finalization

+ 328 - 0
packages/fcl-db/src/datadict/fpdddiff.pp

@@ -0,0 +1,328 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team
+
+    Data Dictionary diff mechanism, compare 2 data dictionaries.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit fpdddiff;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpdatadict;
+
+type
+
+  TDiffKind = (DiffTables, DiffFields, DiffIndexes, DiffSequences, DiffDomains);
+  TDiffKindSet = set of TDiffKind;
+
+  TDifferenceType = (dtMissing, dtDifferent, dtSurplus);
+  
+const
+  diffAll = [DiffTables, DiffFields, DiffIndexes, DiffSequences, DiffDomains];
+  
+type
+  
+  { TCustomDDDiffer }
+
+  TCustomDDDiffer = class
+  private
+    FSourceDD: TFPdatadictionary;
+    FTargetDD: TFPdatadictionary;
+  protected
+    procedure DomainDifference (DiffType: TDifferenceType; SourceDomain, TargetDomain: TDDDomainDef); virtual;
+    procedure SequenceDifference (DiffType: TDifferenceType; SourceSequence, TargetSequence: TDDSequenceDef); virtual;
+    procedure TableDifference (DiffType: TDifferenceType; SourceTable, TargetTable: TDDTableDef); virtual;
+    procedure IndexDifference (DiffType: TDifferenceType; SourceIndex, TargetIndex: TDDIndexDef); virtual;
+    procedure FieldDifference (DiffType: TDifferenceType; SourceField, TargetField: TDDFieldDef); virtual;
+    procedure CompareTables (Kind: TDiffKindSet);
+    procedure CompareTable (TableName: string; Kind: TDiffKindSet);
+    procedure CompareFields (Source, Target: TDDFieldDefs; Kind: TDiffKindSet);
+    procedure CompareField (Source, Target: TDDFieldDefs; Fieldname: string; Kind: TDiffKindSet);
+    procedure CompareIndexes (Source, Target: TDDIndexDefs; Kind: TDiffKindSet);
+    procedure CompareIndex (Source, Target: TDDIndexDefs; Indexname: string; Kind: TDiffKindSet);
+    procedure CompareDomains (Kind: TDiffKindSet);
+    procedure CompareDomain (Source, Target: TDDDomainDefs; DomainName: string; Kind: TDiffKindSet);
+    procedure CompareSequences (Kind: TDiffKindSet);
+    procedure CompareSequence (Source, Target: TDDSequenceDefs; SequenceName: string; Kind: TDiffKindSet);
+  public
+    procedure Compare (Kind: TDiffKindSet);
+    property SourceDD : TFPdatadictionary read FSourceDD write FSourceDD;
+    property TargetDD : TFPdatadictionary read FTargetDD write FTargetDD;
+  end;
+  
+  EDataDictDiff = Class(EDataDict);
+  
+implementation
+
+uses db;
+
+resourcestring
+  SErrMissingDatadict = 'Source and/or target datadictionary not assigned.';
+
+{ TCustomDDDiffer }
+
+procedure TCustomDDDiffer.DomainDifference(DiffType: TDifferenceType;
+  SourceDomain, TargetDomain: TDDDomainDef);
+begin
+
+end;
+
+procedure TCustomDDDiffer.SequenceDifference(DiffType: TDifferenceType;
+  SourceSequence, TargetSequence: TDDSequenceDef);
+begin
+
+end;
+
+procedure TCustomDDDiffer.TableDifference(DiffType: TDifferenceType;
+  SourceTable, TargetTable: TDDTableDef);
+begin
+end;
+
+procedure TCustomDDDiffer.IndexDifference(DiffType: TDifferenceType;
+  SourceIndex, TargetIndex: TDDIndexDef);
+begin
+end;
+
+procedure TCustomDDDiffer.FieldDifference(DiffType: TDifferenceType;
+  SourceField, TargetField: TDDFieldDef);
+begin
+end;
+
+procedure TCustomDDDiffer.CompareTables(Kind: TDiffKindSet);
+
+var
+  List : TStringlist;
+  r : integer;
+
+begin
+  List := TStringlist.Create;
+  try
+    List.Duplicates:=dupIgnore;
+    List.sorted := true;
+    for r := 0 to SourceDD.Tables.Count-1 do
+      List.Add (SourceDD.Tables[r].TableName);
+    for r := 0 to TargetDD.Tables.Count-1 do
+      List.Add (TargetDD.Tables[r].TableName);
+    for r := 0 to List.count-1 do
+      CompareTable (List[r], Kind);
+  finally
+    List.Free;
+  end;
+end;
+
+procedure TCustomDDDiffer.CompareTable(TableName: string; Kind: TDiffKindSet);
+
+var
+  Src, Targ : TDDTableDef;
+begin
+  Src := FSourceDD.Tables.FindTable(TableName);
+  Targ := FTargetDD.Tables.FindTable(TableName);
+  if Not assigned (Targ) then
+    begin
+    if DiffTables in Kind then
+      TableDifference (dtMissing, Src, nil);
+    end
+  else if not assigned (Src) then
+    begin
+    if DiffTables in Kind then
+      TableDifference (dtSurplus, nil, Targ);
+    end
+  else
+    begin  // table exists in source and target, compare fields and Indexes
+    if DiffFields in Kind then
+      CompareFields (Src.Fields, Targ.Fields, Kind);
+    if DiffIndexes in Kind then
+      CompareIndexes(Src.Indexes, Targ.Indexes, Kind);
+    end;
+end;
+
+procedure TCustomDDDiffer.CompareFields(Source, Target: TDDFieldDefs;
+  Kind: TDiffKindSet);
+var
+  FieldList : TStringlist;
+  r : integer;
+begin
+  FieldList := TStringlist.Create;
+  try
+    FieldList.Duplicates := dupIgnore;
+    FieldList.Sorted := true;
+    for r := 0 to Source.Count-1 do
+      FieldList.Add (Source[r].FieldName);
+    for r := 0 to Target.Count-1 do
+      FieldList.Add (Target[r].FieldName);
+    for r := 0 to FieldList.count-1 do
+      CompareField(Source, Target, FieldList[r], Kind);
+  finally
+    FieldList.Free;
+  end;
+end;
+
+procedure TCustomDDDiffer.CompareField(Source, Target: TDDFieldDefs;
+  Fieldname: string; Kind: TDiffKindSet);
+
+  Function FieldTypesEqual(F1,F2 : TDDFieldDef) : boolean;
+
+  begin
+    Result:=(F1.FieldType=F2.FieldType);
+  end;
+
+var
+  Src, Targ : TDDFieldDef;
+begin
+  Src := Source.FindField(FieldName);
+  Targ := Target.FindField(FieldName);
+  if not assigned (Targ) then
+    FieldDifference(dtMissing, Src, nil)
+  else if not assigned (Src) then
+    FieldDifference(dtSurplus, nil, Targ)
+  else if (Not FieldTypesEqual(Src,Targ))
+          or (Src.required <> Targ.required)
+          or (Src.DomainName <> Targ.DomainName)
+          or (Src.DefaultExpression <> Targ.DefaultExpression)
+          or ((Src.Size <> Targ.Size) and not (Src.Fieldtype in [ftBlob]))
+          or (Src.Precision <> Targ.Precision) then
+    FieldDifference(dtDifferent, Src, Targ)
+end;
+
+procedure TCustomDDDiffer.CompareIndexes(Source, Target: TDDIndexDefs;
+  Kind: TDiffKindSet);
+var
+  IndexList : TStringlist;
+  r : integer;
+begin
+  IndexList := TStringlist.Create;
+  try
+    IndexList.Duplicates := dupIgnore;
+    IndexList.Sorted := true;
+    for r := 0 to Source.Count-1 do
+      IndexList.Add (Source[r].IndexName);
+    for r := 0 to Target.Count-1 do
+      IndexList.Add (Target[r].IndexName);
+    for r := 0 to IndexList.count-1 do
+      CompareIndex(Source, Target, IndexList[r], Kind);
+  finally
+    IndexList.Free;
+  end;
+end;
+
+procedure TCustomDDDiffer.CompareIndex(Source, Target: TDDIndexDefs;
+  Indexname: string; Kind: TDiffKindSet);
+var
+  Src, Targ : TDDIndexDef;
+begin
+  Src := Source.FindIndex(IndexName);
+  Targ := Target.FindIndex(IndexName);
+  if not assigned (Targ) then
+    IndexDifference(dtMissing, Src, nil)
+  else if not assigned (Src) then
+    IndexDifference(dtSurplus, nil, Targ)
+  else if (CompareText(Src.Expression,Targ.Expression) <> 0) or
+          (CompareText(Src.Fields,Targ.Fields) <> 0) or
+          (Src.Options <> Targ.Options) or
+          (CompareText(Src.DescFields,Targ.DescFields) <> 0) or
+          (CompareText(Src.CaseInsFields,Targ.CaseInsFields) <> 0) then
+    IndexDifference(dtDifferent, Src, Targ)
+end;
+
+procedure TCustomDDDiffer.CompareDomains(Kind: TDiffKindSet);
+
+Var
+  List : TStringList;
+  R : Integer;
+
+begin
+  List := TStringlist.Create;
+  try
+    List.Duplicates:=dupIgnore;
+    List.sorted := true;
+    for r := 0 to SourceDD.Domains.Count-1 do
+      List.Add (SourceDD.Domains[r].DomainName);
+    for r := 0 to TargetDD.Domains.Count-1 do
+      List.Add (TargetDD.Domains[r].DomainName);
+    for r := 0 to List.count-1 do
+      CompareDomain (SourceDD.Domains,TargetDD.Domains,List[r], Kind);
+  finally
+    List.Free;
+  end;
+end;
+
+procedure TCustomDDDiffer.CompareDomain(Source, Target: TDDDomainDefs;
+  DomainName: string; Kind: TDiffKindSet);
+
+var
+  Src,Targ : TDDDomainDef;
+
+begin
+  Src := Source.FindDomain(DomainName);
+  Targ := Target.FindDomain(DomainName);
+  if not assigned (Targ) then
+    DomainDifference(dtMissing, Src, nil)
+  else if not assigned (Src) then
+    DomainDifference(dtSurplus, nil, Targ)
+  else if (Src.FieldType<>Targ.FieldType) or
+          (Src.Required<>Targ.Required) or
+          (Src.Precision<>Targ.Precision) or
+          (Src.Size<>Targ.Size) then
+    DomainDifference(dtDifferent, Src, Targ)
+end;
+
+procedure TCustomDDDiffer.CompareSequences(Kind: TDiffKindSet);
+
+Var
+  List : TStringList;
+  R : Integer;
+
+begin
+  List := TStringlist.Create;
+  try
+    List.Duplicates:=dupIgnore;
+    List.sorted := true;
+    for r := 0 to SourceDD.Sequences.Count-1 do
+      List.Add (SourceDD.Sequences[r].SequenceName);
+    for r := 0 to TargetDD.Sequences.Count-1 do
+      List.Add (TargetDD.Sequences[r].SequenceName);
+    for r := 0 to List.count-1 do
+      CompareSequence (SourceDD.Sequences,TargetDD.Sequences,List[r], Kind);
+  finally
+    List.Free;
+  end;
+end;
+
+procedure TCustomDDDiffer.CompareSequence(Source, Target: TDDSequenceDefs;
+  SequenceName: string; Kind: TDiffKindSet);
+
+var
+  Src,Targ : TDDSequenceDef;
+
+begin
+  Src := Source.FindSequence(SequenceName);
+  Targ := Target.FindSequence(SequenceName);
+  if not assigned (Targ) then
+    SequenceDifference(dtMissing, Src, nil)
+  else if not assigned (Src) then
+    SequenceDifference(dtSurplus, nil, Targ)
+  else if (Src.StartValue<>Targ.StartValue) or
+          (Src.Increment<>Targ.Increment) then
+    SequenceDifference(dtDifferent, Src, Targ)
+end;
+
+procedure TCustomDDDiffer.Compare (Kind: TDiffKindSet);
+begin
+  if not assigned (FSourceDD) or not assigned (FTargetDD) then
+    raise EDataDictDiff.Create(SErrMissingDatadict);
+  CompareTables (Kind);
+end;
+
+end.
+

+ 181 - 2
packages/fcl-db/src/datadict/fpddfb.pp

@@ -25,11 +25,22 @@ uses
 Type
 
   { TSQLDBFBDDEngine }
-  
+
+  { TFPDDFBSQLEngine }
+
+  TFPDDFBSQLEngine = Class(TFPDDSQLEngine)
+  Public
+    Function  CreateSequenceSQL(Sequence : TDDSequenceDef) : String; override;
+  end;
+
   TSQLDBFBDDEngine = Class(TSQLDBDDEngine)
+  private
   Protected
     Function CreateConnection(AConnectString  : String) : TSQLConnection; override;
   Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; virtual;
+    function ImportFields(Table: TDDTableDef): Integer; override;
+    Function CreateSQLEngine : TFPDDSQLEngine; override;
     Class function Description : string; override;
     Class function DBType : String; override;
   end;
@@ -43,7 +54,7 @@ Procedure UnRegisterFBDDEngine;
 
 implementation
 
-uses ibconnection;
+uses ibconnection, db;
 
 Procedure RegisterFBDDEngine;
 
@@ -65,6 +76,12 @@ begin
   Result:=TIBConnection.Create(Self);
 end;
 
+class function TSQLDBFBDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=[ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
+           ecRunQuery, ecRowsAffected, ecSequences, ecDomains];
+end;
+
 class function TSQLDBFBDDEngine.Description: string;
 begin
   Result:='Firebird/Interbase connection using SQLDB';
@@ -75,5 +92,167 @@ begin
   Result:='Firebird/Interbase';
 end;
 
+function TSQLDBFBDDEngine.ImportFields(Table: TDDTableDef): Integer;
+Const
+  SQL = 'SELECT ' +
+        ' F.RDB$FIELD_POSITION as FieldPosition,' +
+        ' F.RDB$FIELD_NAME as Name,' +
+        ' F.RDB$NULL_FLAG as FieldNull,' +
+        ' F.RDB$Description as Description,' +
+        ' F.RDB$DEFAULT_SOURCE as FieldDefault,' +
+        ' D.RDB$DEFAULT_SOURCE as DomainDefault,' +
+        ' D.RDB$FIELD_LENGTH as CharLength,' +
+        ' D.RDB$FIELD_PRECISION as FieldPrecision,' +
+        ' D.RDB$FIELD_SCALE as Scale,' +
+        ' D.RDB$FIELD_TYPE as FieldType,' +
+        ' D.RDB$FIELD_SUB_TYPE as Subtype,' +
+        ' D.RDB$NULL_FLAG as DomainNull ' +
+        ' FROM '+
+        ' RDB$RELATION_FIELDS F left join RDB$FIELDS D on F.RDB$FIELD_Source = D.RDB$FIELD_NAME'+
+        ' WHERE (RDB$RELATION_NAME = ''%s'')' +
+        ' ORDER BY RDB$FIELD_POSITION';
+
+Var
+  Q : TSQLQuery;
+  FName, FPosition, FFieldnull, FDescription, FFieldDefault, FDomainDefault,
+  FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
+
+  procedure BindFields;
+  begin
+    FName := q.fieldbyname('Name');
+    FPosition := q.fieldbyname('FieldPosition');
+    FFieldnull := q.fieldbyname('FieldNull');
+    FDescription := q.fieldbyname('Description');
+    FFieldDefault := q.fieldbyname('FieldDefault');
+    FDomainDefault := q.fieldbyname('DomainDefault');
+    FCharLength := q.fieldbyname('CharLength');
+    FPrecision := q.fieldbyname('FieldPrecision');
+    FScale := q.fieldbyname('Scale');
+    FFieldType := q.fieldbyname('FieldType');
+    FSubType := q.fieldbyname('SubType');
+    FDomainnull := q.fieldbyname('Domainnull');
+  end;
+
+  function ConvertFBFieldType (FDfieldtype, FBsubtype : integer) : TFieldType;
+  var t : integer;
+      b : byte;
+  begin
+    t := FFieldType.asinteger;
+    if t > 255 then
+      begin
+      if t = 261 then
+        result := ftBlob       {BLOB}
+      else
+        result := ftUnknown;
+      end
+    else
+      begin
+      b := byte(t and $FF);
+      if (b in [7,8,16]) and (FBsubtype <> 0) then
+        // BCD types: 1= Numeric, 2 := Decimal
+        result := ftBCD
+      else
+        case b of
+          14 : result := ftFixedChar; {CHAR}
+          37 : result := ftString;    {VARCHAR}
+          40 : result := ftString;    {CSTRING ?}
+          11 : result := ftFloat;     {D-FLOAT ?}
+          27 : result := ftFloat;     {DOUBLE}
+          10 : result := ftFloat;     {FLOAT}
+          16 : result := ftLargeint;  {INT64}
+          8  : result := ftInteger;   {INTEGER}
+          9  : result := ftlargeint;  {QUAD ?}
+          7  : result := ftSmallint;  {SMALLINT}
+          12 : result := ftDate;      {DATE dialect 3}
+          13 : result := ftTime;      {TIME}
+          35 : result := ftDateTime;  {TIMESTAMP dialect 3, DATE in dialect 1,2}
+          else result := ftUnknown;
+        end;
+      end;
+  end;
+
+  {Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
+
+  function ImportFieldDef : boolean;
+  var FD : TDDFieldDef;
+      n, s : string;
+  begin
+    n := trim(FName.asstring);
+    FD := Table.Fields.FindField(n);
+    if not assigned (FD) then
+      FD := Table.AddField(n);
+    FD.FieldName := n;
+    FD.FieldType := ConvertFBFieldType (FFieldType.asinteger, FSubType.asinteger);
+    FD.Precision := FPrecision.asinteger;
+    if FScale.asinteger < 0 then
+      FD.Size := -FScale.asinteger
+    else if FD.Fieldtype in [ftString, ftFixedChar] then
+      FD.Size := FCharLength.asinteger
+    else
+      FD.Size := 0;
+      { // Fixed length types don't have a size in the dictionary
+      case byte(FFieldType.asinteger and $FF) of
+        7 : FD.Size := 2;
+        10,8 : FD.Size := 4;
+        35,11,27,9,16,12 : FD.Size := 8;
+      end; }
+    if not fDescription.IsNull then
+      FD.Hint := FDescription.asstring;
+    s := trim(FFieldDefault.asstring);
+    n := trim(FDomainDefault.asstring);
+    if s <> '' then
+      FD.DefaultExpression:=s
+    else if n <> '' then;
+      FD.DefaultExpression:=n;
+    if FFieldnull.asinteger = 1 then
+      FD.Required:=true
+    else if FDomainnull.asinteger = 1 then
+      FD.Required:=true
+    else
+      FD.Required:=false;
+    FD.index := FPosition.AsInteger;
+    result := true;
+  end;
+
+  function ImportFromSQLDef : integer;
+  begin
+    result := 0;
+    Q.First;
+    BindFields;
+    while not Q.eof do
+      begin
+      if ImportFieldDef then
+        inc (result);
+      Q.Next;
+      end;
+  end;
+
+begin
+  Q:=CreateSQLQuery(Nil);
+  try
+    Q.Sql.Text:=Format(SQL,[Table.TableName]);
+    Q.Open;
+    try
+      result := ImportFromSQLDef;
+    finally
+      Q.CLose;
+    end;
+  finally
+    Q.Free;
+  end;
+end;
+
+function TSQLDBFBDDEngine.CreateSQLEngine: TFPDDSQLEngine;
+begin
+  Result:=TFPDDFBSQLEngine.Create;
+end;
+
+{ TFPDDFBSQLEngine }
+
+function TFPDDFBSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): String;
+begin
+  Result:='CREATE GENERATOR '+Sequence.SequenceName;
+end;
+
 end.
 

+ 2 - 1
packages/fcl-db/src/datadict/fpddsqldb.pp

@@ -115,6 +115,7 @@ end;
 function TSQLDBDDEngine.GetTableList(List: TStrings): Integer;
 begin
   FConn.GetTableNames(List,False);
+  result := list.count;
 end;
 
 function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
@@ -124,7 +125,7 @@ Const
 
 Var
   Q : TSQLQuery;
-  
+
 begin
   Q:=CreateSQLQuery(Nil);
   try

+ 2 - 1
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -659,8 +659,9 @@ begin
       begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
         TransType, TransLen);
+
       FD := TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(SQLDA^.SQLVar[x].AliasName), TransType,
-         TransLen, False, (x + 1));
+         TransLen, (SQLDA^.SQLVar[x].sqltype and 1)=0, (x + 1));
       if TransType = ftBCD then
         case (SQLDA^.SQLVar[x].sqltype and not 1) of
           SQL_SHORT : FD.precision := 4;

+ 394 - 0
packages/fcl-db/tests/testdddiff.pp

@@ -0,0 +1,394 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team
+
+    FPCUnit fpdddiff test.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit testdddiff;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, testregistry, fpcunit, fpdddiff, fpdatadict;
+
+type
+
+  { TMyDiff }
+
+  TMyDiff = class (TCustomDDDiffer)
+  private
+    FMsg: TStringlist;
+    function GetIndexName (ID : TDDIndexDef) : string;
+    function GetFieldName (FD : TDDFieldDef) : string;
+  protected
+    procedure TableDifference (DiffType: TDifferenceType; SourceTable, TargetTable: TDDTableDef); override;
+    procedure IndexDifference (DiffType: TDifferenceType; SourceIndex, TargetIndex: TDDIndexDef); override;
+    procedure FieldDifference (DiffType: TDifferenceType; SourceField, TargetField: TDDFieldDef); override;
+  public
+    Constructor create;
+    destructor destroy; override;
+  public
+    property Messages : TStringlist read FMsg;
+  end;
+  
+  { TTestDDDiff }
+
+  TTestDDDiff = class (TTestcase)
+  private
+    Differ : TMyDiff;
+    SourceDD, TargetDD : TFPDataDictionary;
+    procedure SetupSourceDD;
+    procedure SetupTargetDD;
+    function CreateTable (DD: TFPDataDictionary; tablename:string) : TDDTableDef;
+    procedure AssertMessageCount (ACount: integer);
+    procedure AssertMessage (AMessage: string);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestEquals;
+    procedure TestSourceTable;
+    procedure TestTargetTable;
+    procedure TestSourceField;
+    procedure TestTargetField;
+    procedure TestSourceIndex;
+    procedure TestTargetIndex;
+    procedure TestFieldType;
+    procedure TestFieldSize;
+    procedure TestFieldPrecision;
+    procedure TestFieldDefExpression;
+    procedure TestFieldRequired;
+    procedure TestIndexOptions;
+    procedure TestIndexExpression;
+    procedure TestIndexFields;
+    procedure TestIndexDescFields;
+    procedure TestIndexCaseInsFields;
+  end;
+  
+  
+implementation
+
+uses db;
+
+{ TMyDiff }
+
+function TMyDiff.GetIndexName(ID: TDDIndexDef): string;
+begin
+  result := TDDIndexdefs(ID.Collection).TableName + '.' + ID.IndexName;
+end;
+
+function TMyDiff.GetFieldName(FD: TDDFieldDef): string;
+begin
+  result := TDDFielddefs(FD.Collection).TableName + '.' + FD.FieldName;
+end;
+
+procedure TMyDiff.TableDifference(DiffType: TDifferenceType; SourceTable,
+  TargetTable: TDDTableDef);
+begin
+  case DiffType of
+    dtMissing: FMsg.Add (format('ST %s', [SourceTable.TableName]));
+    dtSurplus: FMsg.Add (format('TT %s', [TargetTable.TableName]));
+    dtDifferent: FMsg.Add (format('DT', [TargetTable.TableName]));
+  end;
+end;
+
+procedure TMyDiff.IndexDifference(DiffType: TDifferenceType; SourceIndex,
+  TargetIndex: TDDIndexDef);
+begin
+  case DiffType of
+    dtMissing: FMsg.Add (format('SI %s', [getindexname(SourceIndex)]));
+    dtSurplus: FMsg.Add (format('TI %s', [getindexname(TargetIndex)]));
+    dtDifferent: FMsg.Add (format('DI %s', [getindexname(TargetIndex)]));
+  end;
+end;
+
+procedure TMyDiff.FieldDifference(DiffType: TDifferenceType; SourceField,
+  TargetField: TDDFieldDef);
+begin
+  case DiffType of
+    dtMissing: FMsg.Add (format('SF %s', [getfieldname(SourceField)]));
+    dtSurplus: FMsg.Add (format('TF %s', [getfieldname(TargetField)]));
+    dtDifferent: FMsg.Add (format('DF %s', [getfieldname(TargetField)]));
+  end;
+end;
+
+constructor TMyDiff.create;
+begin
+  inherited;
+  FMsg := TStringlist.Create;
+end;
+
+destructor TMyDiff.destroy;
+begin
+  FMsg.Free;
+  inherited destroy;
+end;
+
+{ TTestDDDiff }
+
+procedure TTestDDDiff.SetupSourceDD;
+begin
+  SourceDD := TFPDataDictionary.Create;
+  CreateTable (SourceDD, 'EERSTE');
+  CreateTable (SourceDD, 'TWEEDE');
+end;
+
+procedure TTestDDDiff.SetupTargetDD;
+begin
+  TargetDD := TFPDataDictionary.Create;
+  CreateTable (TargetDD, 'EERSTE');
+  CreateTable (TargetDD, 'TWEEDE');
+end;
+
+function TTestDDDiff.CreateTable(DD: TFPDataDictionary; tablename: string): TDDTableDef;
+begin
+  result := dd.Tables.AddTable(tablename);
+  with result.Fields.AddField('ID') do
+    begin
+    FieldType := ftLargeint;
+    Required:=True;
+    end;
+  with result.Fields.AddField('eerste') do
+    begin
+    FieldType := ftString;
+    Required:=True;
+    Size := 25;
+    end;
+  with result.Fields.AddField('Tweede') do
+    begin
+    FieldType := ftFloat;
+    Required:=False;
+    Size := 12;
+    Precision := 4;
+    end;
+  with result.Fields.AddField('Extralang') do
+    begin
+    FieldType := ftString;
+    Required:=false;
+    Size := 1024;
+    end;
+  with result.Indexes.AddDDIndexDef('Primary') do
+    begin
+    Fields:='ID';
+    options := [ixPrimary];
+    end;
+  with result.Indexes.AddDDIndexDef('UniqueEerste') do
+    begin
+    Fields:='eerste,tweede';
+    DescFields:='eerste';
+    options := [ixUnique];
+    end;
+end;
+
+procedure TTestDDDiff.AssertMessageCount(ACount: integer);
+begin
+  AssertEquals('Number of differences', ACount, Differ.Messages.count);
+end;
+
+procedure TTestDDDiff.AssertMessage(AMessage: string);
+begin
+  if Differ.Messages.count > 1 then
+    Fail ('More differences then expected: expected '+AMessage+', got '+differ.Messages.Commatext)
+  else if Differ.messages.count = 0 then
+    Fail ('No differences found, expected 1: '+AMessage);
+  AssertEquals ('Difference detected,', AMessage, Differ.Messages[0])
+end;
+
+procedure TTestDDDiff.SetUp;
+begin
+  inherited SetUp;
+  SetupSourceDD;
+  SetupTargetDD;
+  Differ := TMyDiff.Create;
+  Differ.SourceDD := SourceDD;
+  Differ.TargetDD := TargetDD;
+end;
+
+procedure TTestDDDiff.TearDown;
+begin
+  Differ.Free;
+  FreeAndNil(SourceDD);
+  FreeAndNil(TargetDD);
+  inherited TearDown;
+end;
+
+procedure TTestDDDiff.TestEquals;
+begin
+  Differ.Compare(diffAll);
+  AssertMessageCount (0);
+end;
+
+procedure TTestDDDiff.TestSourceTable;
+begin
+  SourceDD.Tables.AddTable ('eentabel');
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('ST eentabel');
+end;
+
+procedure TTestDDDiff.TestTargetTable;
+begin
+  TargetDD.Tables.AddTable ('eentabel');
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('TT eentabel');
+end;
+
+procedure TTestDDDiff.TestSourceField;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').AddField ('extra') do
+    begin
+    FieldType := ftCurrency;
+    size := 12;
+    precision := 2;
+    required := true;
+    end;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('SF TWEEDE.extra');
+end;
+
+procedure TTestDDDiff.TestTargetField;
+begin
+  with TargetDD.Tables.TableByName('TWEEDE').AddField ('extra') do
+    begin
+    FieldType := ftCurrency;
+    size := 12;
+    precision := 2;
+    required := true;
+    end;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('TF TWEEDE.extra');
+end;
+
+procedure TTestDDDiff.TestSourceIndex;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.AddIndex ('extra') do
+    begin
+    Fields := 'Tweede';
+    Options := [ixUnique];
+    end;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('SI TWEEDE.extra');
+end;
+
+procedure TTestDDDiff.TestTargetIndex;
+begin
+  with TargetDD.Tables.TableByName('TWEEDE').Indexes.AddIndex ('extra') do
+    begin
+    Fields := 'Tweede';
+    Options := [ixUnique];
+    end;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('TI TWEEDE.extra');
+end;
+
+procedure TTestDDDiff.TestFieldType;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
+    FieldType := ftCurrency;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DF TWEEDE.Tweede');
+end;
+
+procedure TTestDDDiff.TestFieldSize;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
+    Size := 16;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DF TWEEDE.Tweede');
+end;
+
+procedure TTestDDDiff.TestFieldPrecision;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
+    Precision := 0;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DF TWEEDE.Tweede');
+end;
+
+procedure TTestDDDiff.TestFieldDefExpression;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
+    DefaultExpression := '258.2345';
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DF TWEEDE.Tweede');
+end;
+
+procedure TTestDDDiff.TestFieldRequired;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
+    Required := true;
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DF TWEEDE.Tweede');
+end;
+
+procedure TTestDDDiff.TestIndexOptions;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
+    Options := [ixUnique, ixDescending];
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DI TWEEDE.UniqueEerste');
+end;
+
+procedure TTestDDDiff.TestIndexExpression;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
+    Expression := 'Eerste+Tweede';
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DI TWEEDE.UniqueEerste');
+end;
+
+procedure TTestDDDiff.TestIndexFields;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
+    Fields := 'Eerste';
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DI TWEEDE.UniqueEerste');
+end;
+
+procedure TTestDDDiff.TestIndexDescFields;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
+    DescFields := 'Tweede';
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DI TWEEDE.UniqueEerste');
+end;
+
+procedure TTestDDDiff.TestIndexCaseInsFields;
+begin
+  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
+    CaseInsFields := 'Eesrte';
+  Differ.Compare(diffAll);
+  AssertMessageCount (1);
+  AssertMessage ('DI TWEEDE.UniqueEerste');
+end;
+
+initialization
+
+  RegisterTest (TTestDDDiff);
+  
+end.
+

+ 2 - 1
packages/fcl-fpcunit/src/fpcunit.pp

@@ -302,7 +302,7 @@ Resourcestring
   SMethodNotFound = 'Method <%s> not found';
   SNoValidInheritance = ' does not inherit from TTestCase';
   SNoValidTests = 'No valid tests found in ';
-
+  SNoException = 'no exception';
 
 implementation
 
@@ -712,6 +712,7 @@ begin
   Passed := False;
   try
     AMethod;
+    ExceptionName:=SNoException;
   except
     on E: Exception do
     begin