Merged revisions 3456,3459-3460,3462,3484,3568,3571,3682,3689,3774,3783-3785,3798-3799,3809,3811,3820,3824-3825,3833,3842 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r3456 | vincents | 2006-05-08 15:43:43 +0200 (Mon, 08 May 2006) | 1 line

* pipe handles are THandle
........
r3459 | micha | 2006-05-08 22:30:25 +0200 (Mon, 08 May 2006) | 1 line

tdbf cvs updates
........
r3460 | joost | 2006-05-08 22:58:05 +0200 (Mon, 08 May 2006) | 1 line

 + Temporary fix for compilation
........
r3462 | micha | 2006-05-09 18:23:07 +0200 (Tue, 09 May 2006) | 1 line

compile fixes: remove UseFloatFields entirely
........
r3484 | joost | 2006-05-12 17:13:27 +0200 (Fri, 12 May 2006) | 1 line

 + initial implementation of DB Unit Tests
........
r3568 | florian | 2006-05-18 22:20:55 +0200 (Thu, 18 May 2006) | 2 lines

* TDOMNodeList.GetCount speed up from alexx, fixes #6891

........
r3571 | joost | 2006-05-18 23:29:15 +0200 (Thu, 18 May 2006) | 2 lines

 + restructured
 + added TTestFieldTypes.TestString and TestDate
........
r3682 | joost | 2006-05-26 13:28:20 +0200 (Fri, 26 May 2006) | 4 lines

 + added support for postgresql for test-framework
 + rewrote fieldtests (removed variant dependency)
 + added test for ftDateTime and unlimited VARCHAR
 + fieldnames are not case-sensitive for all RDMS
........
r3689 | florian | 2006-05-27 10:33:23 +0200 (Sat, 27 May 2006) | 2 lines

+ fixed missing class directives, poped up after yesterdays changes

........
r3774 | joost | 2006-06-03 14:31:14 +0200 (Sat, 03 Jun 2006) | 2 lines

 + added mysql
 + added parameters-tests
........
r3783 | michael | 2006-06-04 11:27:38 +0200 (Sun, 04 Jun 2006) | 6 lines

* Some improvements by Sergei Gorelkin
  - xmlread now detects encoding. (UTF8 and UTF16)
  - xmlread now uses single pass sequential reading mechanism
  - xmlwrite now uses a couple of classes, making it thread-safe
   

........
r3784 | michael | 2006-06-04 11:47:29 +0200 (Sun, 04 Jun 2006) | 1 line

+ Use native lineending; Use Out instead of var to avoid warnings
........
r3785 | michael | 2006-06-04 11:50:43 +0200 (Sun, 04 Jun 2006) | 1 line

+ Fix for writing more than 60 colors in palette or no palette at all (by Colin Western)
........
r3798 | tom_at_work | 2006-06-04 21:46:41 +0200 (Sun, 04 Jun 2006) | 1 line

* fixed compilation on big endian machines
........
r3799 | michael | 2006-06-04 21:51:52 +0200 (Sun, 04 Jun 2006) | 1 line

+ Renamed Action Parameter of TDatasetErrorEvent; Avoids conflicts in methods in forms in objfpc mode
........
r3809 | joost | 2006-06-05 17:37:25 +0200 (Mon, 05 Jun 2006) | 1 line

 + added more tests and some fixes for the change behaviour of MySQL
........
r3811 | michael | 2006-06-05 19:21:07 +0200 (Mon, 05 Jun 2006) | 1 line

+ Patch from Sergey Gorelkin to implement CR/LF folding and fix memory leaks
........
r3820 | joost | 2006-06-07 23:01:21 +0200 (Wed, 07 Jun 2006) | 2 lines

 + implemented bcd-fields for postgresql
 + return 0 if bcd field is null
........
r3824 | michael | 2006-06-08 20:09:03 +0200 (Thu, 08 Jun 2006) | 1 line

+ More patches from Sergei Gorelkin.
........
r3825 | michael | 2006-06-08 20:17:35 +0200 (Thu, 08 Jun 2006) | 1 line

+ Patch to allow uncompressed data after compressed data from Sergei Gorelkin
........
r3833 | joost | 2006-06-09 22:59:06 +0200 (Fri, 09 Jun 2006) | 1 line

 + Fix for the postgresql transaction becoming invalid
........
r3842 | peter | 2006-06-11 12:03:02 +0200 (Sun, 11 Jun 2006) | 2 lines

  * revert r3568, it generates infinite recursion

........

git-svn-id: branches/fixes_2_0@3846 -

.gitattributes

@@ -683,6 +683,17 @@ fcl/db/unmaintained/odbc/testtl.pp svneol=native#text/plain
 fcl/db/unmaintained/sqlite/Makefile -text
 fcl/db/unmaintained/sqlite/Makefile.fpc -text
 fcl/db/unmaintained/sqlite/sqlitedataset.pas svneol=native#text/plain
+fcl/dbtests/Makefile -text
+fcl/dbtests/Makefile.fpc -text
+fcl/dbtests/database.ini -text
+fcl/dbtests/dbftoolsunit.pas -text
+fcl/dbtests/dbtestframework.pas -text
+fcl/dbtests/settings.inc -text
+fcl/dbtests/sqldbtoolsunit.pas -text
+fcl/dbtests/testbasics.pas svneol=native#text/plain
+fcl/dbtests/testdbbasics.pas -text
+fcl/dbtests/testsqlfieldtypes.pas -text
+fcl/dbtests/toolsunit.pas -text
 fcl/fpcunit/Makefile svneol=native#text/plain
 fcl/fpcunit/Makefile.fpc svneol=native#text/plain
 fcl/fpcunit/README.txt svneol=native#text/plain

fcl/db/db.pp

@@ -900,7 +900,7 @@ type
 
   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
-    var Action: TDataAction) of object;
+    var DataAction: TDataAction) of object;
 
   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
   TFilterOptions = set of TFilterOption;

fcl/db/dbase/dbf.pas

@@ -170,7 +170,6 @@ type
     FTableLevel: Integer;
     FExclusive: Boolean;
     FShowDeleted: Boolean;
-    FUseFloatFields: Boolean;
     FPosting: Boolean;
     FDisableResyncOnPost: Boolean;
     FTempExclusive: Boolean;
@@ -354,7 +353,7 @@ type
 
 {$ifdef SUPPORT_VARIANTS}
     function  Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
-    function  Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC_VERSION}override;{$endif}
+    function  Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC}override;{$endif}
 {$endif}
 
     function  IsDeleted: Boolean;
@@ -403,8 +402,6 @@ type
     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
     property TableName: string read FTableName write SetTableName;
     property TableLevel: Integer read FTableLevel write SetTableLevel;
-    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields;
-      (* default {$ifdef SUPPORT_INT64} false {$else} true {$endif}; *)
     property Version: string read GetVersion write SetVersion stored false;
     property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate;
     property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord;
@@ -626,8 +623,6 @@ begin
   FPosting := false;
   FReadOnly := false;
   FExclusive := false;
-  FUseFloatFields := true;
-  //FUseFloatFields := {$ifdef SUPPORT_INT64} false {$else} true {$endif};
   FDisableResyncOnPost := false;
   FTempExclusive := false;
   FCopyDateTimeAsString := false;
@@ -1042,7 +1037,6 @@ begin
     FDbfFile.Mode := FileOpenMode;
   end;
   FDbfFile.AutoCreate := false;
-  FDbfFile.UseFloatFields := FUseFloatFields;
   FDbfFile.DateTimeHandling := FDateTimeHandling;
   FDbfFile.OnLocaleError := FOnLocaleError;
   FDbfFile.OnIndexMissing := FOnIndexMissing;
@@ -1401,7 +1395,6 @@ begin
       begin
         ADbfFieldDefs := TDbfFieldDefs.Create(Self);
         ADbfFieldDefs.DbfVersion := TableLevelToDbfVersion(FTableLevel);
-        ADbfFieldDefs.UseFloatFields := FUseFloatFields;
 
         // get fields -> fielddefs if no fielddefs
 {$ifndef FPC_VERSION}
@@ -2139,11 +2132,15 @@ function TDbf.GetRecNo: Integer; {override virtual}
 var
   pBuffer: pointer;
 begin
-  if State = dsCalcFields then
-    pBuffer := CalcBuffer
-  else
-    pBuffer := ActiveBuffer;
-  Result := pDbfRecord(pBuffer)^.SequentialRecNo;
+  if FCursor <> nil then
+  begin
+    if State = dsCalcFields then
+      pBuffer := CalcBuffer
+    else
+      pBuffer := ActiveBuffer;
+    Result := pDbfRecord(pBuffer)^.SequentialRecNo;
+  end else
+    Result := 0;
 end;
 
 procedure TDbf.SetRecNo(Value: Integer); {override virtual}

fcl/db/dbase/dbf_common.pas

@@ -17,7 +17,7 @@ uses
 
 const
   TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 48;
+  TDBF_MINOR_VERSION      = 49;
   TDBF_SUB_MINOR_VERSION  = 0;
 
   TDBF_TABLELEVEL_FOXPRO = 25;

fcl/db/dbase/dbf_dbffile.pas

@@ -74,8 +74,6 @@ type
 
     function GetLanguageId: Integer;
     function GetLanguageStr: string;
-    function GetUseFloatFields: Boolean;
-    procedure SetUseFloatFields(NewUse: Boolean);
     
   protected
     procedure ConstructFieldDefs;
@@ -134,7 +132,6 @@ type
     property PrevBuffer: PChar read FPrevBuffer;
     property ForceClose: Boolean read FForceClose;
     property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
-    property UseFloatFields: Boolean read GetUseFloatFields write SetUseFloatFields;
     property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling;
 
     property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing;
@@ -320,16 +317,6 @@ begin
   inherited;
 end;
 
-function TDbfFile.GetUseFloatFields: Boolean;
-begin
-  Result := FFieldDefs.UseFloatFields;
-end;
-
-procedure TDbfFile.SetUseFloatFields(NewUse: Boolean);
-begin
-  FFieldDefs.UseFloatFields := NewUse;
-end;
-
 procedure TDbfFile.Open;
 var
   lMemoFileName: string;
@@ -875,7 +862,7 @@ begin
 
       // apply field transformation tricks
       if (lNativeFieldType = 'C') 
-{$ifdef USE_LONG_CHAR_FIELDS}
+{$ifndef USE_LONG_CHAR_FIELDS}
           and (FDbfVersion = xFoxPro) 
 {$endif}
                 then
@@ -1182,7 +1169,6 @@ begin
   DestDbfFile.FileName := NewBaseName;
   DestDbfFile.AutoCreate := true;
   DestDbfFile.Mode := pfExclusiveCreate;
-  DestDbfFile.UseFloatFields := UseFloatFields;
   DestDbfFile.OnIndexMissing := FOnIndexMissing;
   DestDbfFile.OnLocaleError := FOnLocaleError;
   DestDbfFile.DbfVersion := FDbfVersion;

fcl/db/dbase/dbf_fields.pas

@@ -84,7 +84,6 @@ type
   private
     FOwner: TPersistent;
     FDbfVersion: TXBaseVersion;
-    FUseFloatFields: Boolean;
 
     function GetItem(Idx: Integer): TDbfFieldDef;
   protected
@@ -101,7 +100,6 @@ type
 
     property Items[Idx: Integer]: TDbfFieldDef read GetItem;
     property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
-    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields;
   end;
 
 implementation
@@ -350,16 +348,13 @@ begin
           if FSize <= DIGITS_SMALLINT then
             FFieldType := ftSmallInt
           else
-          if TDbfFieldDefs(Collection).UseFloatFields then
-            FFieldType := ftFloat
-          else
-{$ifdef SUPPORT_INT64}
           if FSize <= DIGITS_INTEGER then
             FFieldType := ftInteger
           else
+{$ifdef SUPPORT_INT64}
             FFieldType := ftLargeInt;
 {$else}
-            FFieldType := ftInteger;
+            FFieldType := ftFloat;
 {$endif}
         end else begin
           FFieldType := ftFloat;

fcl/db/dbase/history.txt

@@ -23,7 +23,7 @@ BUGS & WARNINGS
       don't know the index of the field they have to copy from (Dbf_Fields)
 - BCB3/D3 compatibility:
     - you will NOT be able to use Int64 features:
-      - large numeric fields with zero precision (set UseFloatFields to true)
+      - large numeric fields with zero precision (they will be float fields)
       - datetime fields '@'
       - double fields 'O'
       - maybe more...look in source where Int64 is used
@@ -32,6 +32,14 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.4.9
+
+- fix use long char fields check icw foxpro (thx rpoverdijk)
+- fix TDbf.GetRecNo AV when no file open
+- remove UseFloatFields, delphi 3 will use float fields, others not
+
+
 ------------------------
 V6.4.8
 

fcl/db/fields.inc

@@ -2025,11 +2025,9 @@ end;
 
 function TBCDField.GetAsCurrency: Currency;
 
-Var C : system.Currency;
-
 begin
-  if GetData(@C) then
-    result := C;
+  if not GetData(@Result) then
+    result := 0;
 end;
 
 function TBCDField.GetAsVariant: Variant;

fcl/db/sqldb/postgres/pqconnection.pp

@@ -17,13 +17,14 @@ uses
 type
   TPQTrans = Class(TSQLHandle)
     protected
-    TransactionHandle   : PPGConn;
+    PGConn        : PPGConn;
+    ErrorOccured  : boolean;
   end;
 
   TPQCursor = Class(TSQLCursor)
     protected
     Statement : string;
-    tr        : Pointer;
+    tr        : TPQTrans;
     res       : PPGresult;
     CurTuple  : integer;
     Nr        : string;
@@ -73,6 +74,8 @@ type
 
 implementation
 
+uses math;
+
 ResourceString
   SErrRollbackFailed = 'Rollback transaction failed';
   SErrCommitFailed = 'Commit transaction failed';
@@ -110,7 +113,7 @@ end;
 
 function TPQConnection.GetTransactionHandle(trans : TSQLHandle): pointer;
 begin
-  Result := (trans as TPQtrans).TransactionHandle;
+  Result := trans;
 end;
 
 function TPQConnection.RollBack(trans : TSQLHandle) : boolean;
@@ -122,17 +125,17 @@ begin
 
   tr := trans as TPQTrans;
 
-  res := PQexec(tr.TransactionHandle, 'ROLLBACK');
+  res := PQexec(tr.PGConn, 'ROLLBACK');
   if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
     begin
     PQclear(res);
     result := false;
-    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.transactionhandle) + ')',self);
+    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
     end
   else
     begin
     PQclear(res);
-    PQFinish(tr.TransactionHandle);
+    PQFinish(tr.PGConn);
     result := true;
     end;
 end;
@@ -146,17 +149,17 @@ begin
 
   tr := trans as TPQTrans;
 
-  res := PQexec(tr.TransactionHandle, 'COMMIT');
+  res := PQexec(tr.PGConn, 'COMMIT');
   if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
     begin
     PQclear(res);
     result := false;
-    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.transactionhandle) + ')',self);
+    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
     end
   else
     begin
     PQclear(res);
-    PQFinish(tr.TransactionHandle);
+    PQFinish(tr.PGConn);
     result := true;
     end;
 end;
@@ -171,23 +174,24 @@ begin
 
   tr := trans as TPQTrans;
 
-  tr.TransactionHandle := PQconnectdb(pchar(FConnectString));
+  tr.PGConn := PQconnectdb(pchar(FConnectString));
 
-  if (PQstatus(tr.TransactionHandle) = CONNECTION_BAD) then
+  if (PQstatus(tr.PGConn) = CONNECTION_BAD) then
     begin
     result := false;
-    PQFinish(tr.TransactionHandle);
-    DatabaseError(SErrConnectionFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.transactionhandle) + ')',self);
+    PQFinish(tr.PGConn);
+    DatabaseError(SErrConnectionFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
     end
   else
     begin
-    res := PQexec(tr.TransactionHandle, 'BEGIN');
+    tr.ErrorOccured := False;
+    res := PQexec(tr.PGConn, 'BEGIN');
     if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
       begin
       result := false;
       PQclear(res);
-      msg := PQerrorMessage(tr.transactionhandle);
-      PQFinish(tr.TransactionHandle);
+      msg := PQerrorMessage(tr.PGConn);
+      PQFinish(tr.PGConn);
       DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
       end
     else
@@ -205,21 +209,21 @@ var
   msg : string;
 begin
   tr := trans as TPQTrans;
-  res := PQexec(tr.TransactionHandle, 'ROLLBACK');
+  res := PQexec(tr.PGConn, 'ROLLBACK');
   if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
     begin
     PQclear(res);
-    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.transactionhandle) + ')',self);
+    DatabaseError(SErrRollbackFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
     end
   else
     begin
     PQclear(res);
-    res := PQexec(tr.TransactionHandle, 'BEGIN');
+    res := PQexec(tr.PGConn, 'BEGIN');
     if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
       begin
       PQclear(res);
-      msg := PQerrorMessage(tr.transactionhandle);
-      PQFinish(tr.TransactionHandle);
+      msg := PQerrorMessage(tr.PGConn);
+      PQFinish(tr.PGConn);
       DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
       end
     else
@@ -234,21 +238,21 @@ var
   msg : string;
 begin
   tr := trans as TPQTrans;
-  res := PQexec(tr.TransactionHandle, 'COMMIT');
+  res := PQexec(tr.PGConn, 'COMMIT');
   if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
     begin
     PQclear(res);
-    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.transactionhandle) + ')',self);
+    DatabaseError(SErrCommitFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self);
     end
   else
     begin
     PQclear(res);
-    res := PQexec(tr.TransactionHandle, 'BEGIN');
+    res := PQexec(tr.PGConn, 'BEGIN');
     if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
       begin
       PQclear(res);
-      msg := PQerrorMessage(tr.transactionhandle);
-      PQFinish(tr.TransactionHandle);
+      msg := PQerrorMessage(tr.PGConn);
+      PQFinish(tr.PGConn);
       DatabaseError(sErrTransactionFailed + ' (PostgreSQL: ' + msg + ')',self);
       end
     else
@@ -394,7 +398,7 @@ begin
     // So that's not supported.
     if FStatementType in [stInsert,stUpdate,stDelete, stSelect] then
       begin
-      tr := aTransaction.Handle;
+      tr := TPQTrans(aTransaction.Handle);
       // Only available for pq 8.0, so don't use it...
       // Res := pqprepare(tr,'prepst'+name+nr,pchar(buf),params.Count,pchar(''));
       s := 'prepare prepst'+nr+' ';
@@ -412,11 +416,11 @@ begin
         buf := AParams.ParseSQL(buf,false,psPostgreSQL);
         end;
       s := s + ' as ' + buf;
-      res := pqexec(tr,pchar(s));
+      res := pqexec(tr.PGConn,pchar(s));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
         pqclear(res);
-        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr) + ')',self)
+        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
         end;
       FPrepared := True;
       end
@@ -430,13 +434,16 @@ procedure TPQConnection.UnPrepareStatement(cursor : TSQLCursor);
 begin
   with (cursor as TPQCursor) do if FPrepared then
     begin
-    res := pqexec(tr,pchar('deallocate prepst'+nr));
-    if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+    if not tr.ErrorOccured then
       begin
+      res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
+      if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+        begin
+        pqclear(res);
+        DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
+        end;
       pqclear(res);
-      DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr) + ')',self)
       end;
-    pqclear(res);
     FPrepared := False;
     end;
 end;
@@ -473,27 +480,31 @@ begin
           end
         else
           FreeAndNil(ar[i]);
-        res := PQexecPrepared(tr,pchar('prepst'+nr),Aparams.count,@Ar[0],nil,nil,0);
+        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),Aparams.count,@Ar[0],nil,nil,0);
         for i := 0 to AParams.count -1 do
           FreeMem(ar[i]);
         end
       else
-        res := PQexecPrepared(tr,pchar('prepst'+nr),0,nil,nil,nil,1);
+        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),0,nil,nil,nil,1);
       end
     else
       begin
-      tr := aTransaction.Handle;
+      tr := TPQTrans(aTransaction.Handle);
 
       s := statement;
       //Should be altered, just like in TSQLQuery.ApplyRecUpdate
       if assigned(AParams) then for i := 0 to AParams.count-1 do
         s := stringreplace(s,':'+AParams[i].Name,AParams[i].asstring,[rfReplaceAll,rfIgnoreCase]);
-      res := pqexec(tr,pchar(s));
+      res := pqexec(tr.PGConn,pchar(s));
       end;
     if not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       begin
+      s := PQerrorMessage(tr.PGConn);
       pqclear(res);
-      DatabaseError(SErrExecuteFailed + ' (PostgreSQL: ' + PQerrorMessage(tr) + ')',self);
+
+      tr.ErrorOccured := True;
+      atransaction.Rollback;
+      DatabaseError(SErrExecuteFailed + ' (PostgreSQL: ' + s + ')',self);
       end;
     end;
 end;
@@ -549,13 +560,21 @@ end;
 
 function TPQConnection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean;
 
-var
-  x,i          : integer;
-  li           : Longint;
-  CurrBuff     : pchar;
-  tel  : byte;
-  dbl  : pdouble;
+type TNumericRecord = record
+       Digits : SmallInt;
+       Weight : SmallInt;
+       Sign   : SmallInt;
+       Scale  : Smallint;
+     end;
 
+var
+  x,i           : integer;
+  li            : Longint;
+  CurrBuff      : pchar;
+  tel           : byte;
+  dbl           : pdouble;
+  cur           : currency;
+  NumericRecord : ^TNumericRecord;
 
 begin
   with cursor as TPQCursor do
@@ -573,6 +592,8 @@ begin
       i := PQfsize(res, x);
       CurrBuff := pqgetvalue(res,CurTuple,x);
 
+      result := true;
+
       case FieldDef.DataType of
         ftInteger, ftSmallint, ftLargeInt,ftfloat :
           begin
@@ -611,12 +632,30 @@ begin
           end;
         ftBCD:
           begin
-          // not implemented
+          NumericRecord := pointer(CurrBuff);
+          NumericRecord^.Digits := BEtoN(NumericRecord^.Digits);
+          NumericRecord^.Scale := BEtoN(NumericRecord^.Scale);
+          NumericRecord^.Weight := BEtoN(NumericRecord^.Weight);
+          inc(pointer(currbuff),sizeof(TNumericRecord));
+          cur := 0;
+          if (NumericRecord^.Digits = 0) and (NumericRecord^.Scale = 0) then // = NaN, which is not supported by Currency-type, so we return NULL
+            result := false
+          else
+            begin
+            for tel := 1 to NumericRecord^.Digits  do
+              begin
+              cur := cur + beton(pword(currbuff)^) * intpower(10000,-(tel-1)+NumericRecord^.weight);
+              inc(pointer(currbuff),2);
+              end;
+            if BEtoN(NumericRecord^.Sign) <> 0 then cur := -cur;
+            Move(Cur, Buffer^, sizeof(currency));
+            end;
           end;
         ftBoolean:
           pchar(buffer)[0] := CurrBuff[0]
+        else
+          result := false;
       end;
-      result := true;
       end;
     end;
 end;

fcl/dbtests/Makefile

@@ -0,0 +1,1738 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/05/10]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince powerpc64-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=fcl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override TARGET_EXAMPLES+=dbtestframework
+endif
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl 
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(CPU_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-Aas
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_examples
+ifneq ($(TARGET_EXAMPLES),)
+HASEXAMPLES=1
+override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .lpr,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
+override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
+override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
+override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+ifeq ($(OS_TARGET),emx)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
+endif
+endif
+ifneq ($(TARGET_EXAMPLEDIRS),)
+HASEXAMPLES=1
+endif
+fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+fpc_release:
+	$(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+	$(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+	$(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.lpr
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.dpr
+	$(COMPILER) $<
+	$(EXECPPAS)
+%.res: %.rc
+	windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_shared
+override INSTALLTARGET+=fpc_shared_install
+ifndef SHARED_LIBVERSION
+SHARED_LIBVERSION=$(FPC_VERSION)
+endif
+ifndef SHARED_LIBNAME
+SHARED_LIBNAME=$(PACKAGE_NAME)
+endif
+ifndef SHARED_FULLNAME
+SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT)
+endif
+ifndef SHARED_LIBUNITS
+SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS)
+override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS))
+endif
+fpc_shared:
+ifdef HASSHAREDLIB
+	$(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1
+ifneq ($(SHARED_BUILD),n)
+	$(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR)
+endif
+else
+	@$(ECHO) Shared Libraries not supported
+endif
+fpc_shared_install:
+ifneq ($(SHARED_BUILD),n)
+ifneq ($(SHARED_LIBUNITS),)
+ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),)
+	$(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR)
+endif
+endif
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples: fpc_examples
+shared: fpc_shared
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif

fcl/dbtests/Makefile.fpc

@@ -0,0 +1,16 @@
+#
+#   Makefile.fpc for DB TestFramework 
+#
+
+[package]
+main=fcl
+
+[target]
+examples=dbtestframework
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+

fcl/dbtests/database.ini

@@ -0,0 +1,34 @@
+[Database]
+
+# type
+# gives the type of the database-engine. Valid values are:
+# * interbase
+# * mysql
+# * postgresql
+
+type=postgresql
+
+# name
+# gives the name of the database that should be used.
+# This could be a file-name or an alias, dependent on which database-engine is
+# used. More information about how to create a dabatase can be find in the
+# documentation of the database-engine.
+
+name=testdb
+
+# user
+# name is the name of a user which must have all rights on the selected
+# database. If the user has insufficient rights, all or one of the test could
+# fail.
+# How to set up users and their rights can be found in the database-engine
+# documentation.
+
+user=
+
+# password
+# password is the password of the provided user. If the password is incorrect,
+# all or one  of the test could fail.
+
+password=
+
+hostname=

fcl/dbtests/dbftoolsunit.pas

@@ -0,0 +1,73 @@
+unit DBFToolsUnit;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, toolsunit,
+  db,
+  Dbf, dbf_fields;
+
+
+type
+     { TDBFDBConnector }
+
+     TDBFDBConnector = class(TDBConnector)
+     private
+     protected
+       Function CreateNDataset(n : integer) : TDataset; override;
+       Procedure FreeNDataset(var ds : TDataset); override;
+     public
+       destructor Destroy; override;
+     end;
+
+implementation
+
+destructor TDBFDBConnector.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TDBFDBConnector.CreateNDataset(n: integer): TDataset;
+var countID : integer;
+begin
+  with TDbf.Create(nil) do
+    begin
+    FilePath := dbname;
+    TableName := 'fpdev_'+inttostr(n)+'.db';
+    FieldDefs.Add('ID',ftInteger);
+    FieldDefs.Add('NAME',ftString,50);
+    CreateTable;
+    Open;
+    for countId := 1 to n do
+      begin
+      Append;
+      FieldByName('ID').AsInteger := countID;
+      FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
+      end;
+    if state = dsinsert then
+      Post;
+    Close;
+    Free;
+    end;
+// A dataset that has been opened and closed can't be used. Or else the tests
+// for a newly generated dataset can't work properly.
+  Result := TDbf.Create(nil);
+  with (result as TDbf) do
+    begin
+    FilePath := dbname;
+    TableName := 'fpdev_'+inttostr(n)+'.db';
+    end;
+end;
+
+procedure TDBFDBConnector.FreeNDataset(var ds: TDataset);
+begin
+  if ds.Active then ds.close;
+  FreeAndNil(ds);
+end;
+
+end.
+

fcl/dbtests/dbtestframework.pas

@@ -0,0 +1,38 @@
+program dbtestframework;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+{$include settings.inc}
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  fpcunit,testregistry,
+  testbasics,
+{$ifdef SQLDB_AVAILABLE}
+  testsqlfieldtypes,
+{$ENDIF}
+{$IFDEF DBF_AVAILABLE}
+  testdbbasics,
+{$ENDIF}
+  testreport;
+  
+var
+  FXMLResultsWriter: TXMLResultsWriter;
+  testResult: TTestResult;
+begin
+  testResult := TTestResult.Create;
+  FXMLResultsWriter := TXMLResultsWriter.Create;
+  try
+    testResult.AddListener(FXMLResultsWriter);
+    FXMLResultsWriter.WriteHeader;
+    GetTestRegistry.Run(testResult);
+    FXMLResultsWriter.WriteResult(testResult);
+  finally
+    testResult.Free;
+    FXMLResultsWriter.Free;
+  end;
+end.

fcl/dbtests/settings.inc

@@ -0,0 +1,6 @@
+{$IFDEF fpc}
+  {$define SQLDB_AVAILABLE}
+  {$define DBF_AVAILABLE}
+{$ELSE}
+  {$DEFINE DBF_AVAILABLE}
+{$ENDIF}

fcl/dbtests/sqldbtoolsunit.pas

@@ -0,0 +1,153 @@
+unit SQLDBToolsUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, toolsunit,
+  db,
+  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection;
+
+
+type
+
+{ TSQLDBConnector }
+
+     TSQLDBConnector = class(TDBConnector)
+       FConnection   : TSQLConnection;
+       FTransaction  : TSQLTransaction;
+       FQuery        : TSQLQuery;
+     private
+       procedure CreateFConnection;
+       procedure CreateFTransaction;
+       Function CreateQuery : TSQLQuery;
+     protected
+       Procedure FreeNDataset(var ds : TDataset); override;
+       Function CreateNDataset(n : integer) : TDataset; override;
+     public
+       destructor Destroy; override;
+       constructor Create;
+       property Connection : TSQLConnection read FConnection;
+       property Transaction : TSQLTransaction read FTransaction;
+       property Query : TSQLQuery read FQuery;
+     end;
+
+implementation
+
+procedure TSQLDBConnector.CreateFConnection;
+
+begin
+  if dbtype = 'mysql40' then Fconnection := tMySQL40Connection.Create(nil);
+  if dbtype = 'mysql41' then Fconnection := tMySQL41Connection.Create(nil);
+  if dbtype = 'mysql50' then Fconnection := tMySQL50Connection.Create(nil);
+  if dbtype = 'postgresql' then Fconnection := tpqConnection.Create(nil);
+  if dbtype = 'interbase' then Fconnection := tIBConnection.Create(nil);
+  if dbtype = 'odbc' then Fconnection := tODBCConnection.Create(nil);
+  if dbtype = 'oracle' then Fconnection := TOracleConnection.Create(nil);
+
+  if not assigned(Fconnection) then writeln('Invalid database-type, check if a valid database-type was provided in the file ''database.ini''');
+
+  with Fconnection do
+    begin
+    DatabaseName := dbname;
+    UserName := dbuser;
+    Password := dbpassword;
+    HostName := dbhostname;
+    open;
+    end;
+end;
+
+{ TSQLDBConnector }
+
+procedure TSQLDBConnector.CreateFTransaction;
+
+begin
+  Ftransaction := tsqltransaction.create(nil);
+  with Ftransaction do
+    database := Fconnection;
+end;
+
+Function TSQLDBConnector.CreateQuery : TSQLQuery;
+
+begin
+  Result := TSQLQuery.create(nil);
+  with Result do
+    begin
+    database := Fconnection;
+    transaction := Ftransaction;
+    end;
+end;
+
+destructor TSQLDBConnector.Destroy;
+begin
+  try
+    if Ftransaction.Active then Ftransaction.Rollback;
+    Ftransaction.StartTransaction;
+    Fconnection.ExecuteDirect('DROP TABLE FPDEV');
+    Ftransaction.Commit;
+  Except
+    if Ftransaction.Active then Ftransaction.Rollback
+  end;
+  try
+    if Ftransaction.Active then Ftransaction.Rollback;
+    Ftransaction.StartTransaction;
+    Fconnection.ExecuteDirect('DROP TABLE FPDEV2');
+    Ftransaction.Commit;
+  Except
+    if Ftransaction.Active then Ftransaction.Rollback
+  end;
+
+  FreeAndNil(FQuery);
+  FreeAndNil(FTransaction);
+  FreeAndNil(FConnection);
+  inherited Destroy;
+end;
+
+constructor TSQLDBConnector.Create;
+
+var countID : integer;
+
+begin
+  CreateFConnection;
+  CreateFTransaction;
+  FQuery := CreateQuery;
+  FConnection.Transaction := FTransaction;
+
+  try
+    Ftransaction.StartTransaction;
+    Fconnection.ExecuteDirect('create table FPDEV (       ' +
+                              '  ID INT NOT NULL,           ' +
+                              '  NAME VARCHAR(50)          ' +
+                              ')                            ');
+
+    FTransaction.CommitRetaining;
+
+    for countID := 1 to 35 do
+      Fconnection.ExecuteDirect('insert into FPDEV (ID,NAME)' +
+                                'values ('+inttostr(countID)+',''TestName'+inttostr(countID)+''')');
+
+    Ftransaction.Commit;
+  except
+    if Ftransaction.Active then Ftransaction.Rollback
+  end;
+end;
+
+function TSQLDBConnector.CreateNDataset(n: integer): TDataset;
+begin
+  result := CreateQuery;
+  with result as TSQLQuery do
+    begin
+    sql.clear;
+    sql.add('SELECT ID,NAME FROM FPDEV WHERE ID<'+inttostr(n+1));
+    end;
+end;
+
+procedure TSQLDBConnector.FreeNDataset(var ds: TDataset);
+begin
+  if ds.active then ds.Close;
+  FreeAndNil(ds);
+end;
+
+end.
+

fcl/dbtests/testbasics.pas

@@ -0,0 +1,82 @@
+unit TestBasics;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, testdecorator,
+  Classes, SysUtils;
+
+type
+
+  { TTestBasics }
+
+  TTestBasics = class(TTestCase)
+  private
+  protected
+  published
+    procedure TestParseSQL;
+  end;
+
+implementation
+
+uses db, toolsunit;
+
+
+{ TTestBasics }
+
+procedure TTestBasics.TestParseSQL;
+var Params  : TParams;
+    ReplStr : string;
+    pb      : TParamBinding;
+begin
+  Params := TParams.Create;
+  AssertEquals(     'select * from table where id = $1',
+    params.ParseSQL('select * from table where id = :id',true,psPostgreSQL));
+
+  AssertEquals(     'select * from table where id = $1',
+    params.ParseSQL('select * from table where id = :id',false,psPostgreSQL));
+
+  AssertEquals(     'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $2)',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :2)',true,psPostgreSQL));
+
+  AssertEquals(     'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $3) and (test=''$test'')',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :par3) and (test=''$test'')',true,psPostgreSQL));
+
+  AssertEquals(     'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 10=$10 11=$11 12=$5 where (id = $3) and (test=''$test'')',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id = :par3) and (test=''$test'')',true,psPostgreSQL));
+
+
+  AssertEquals(     'select * from table where id = $1',
+    params.ParseSQL('select * from table where id = :id',true,psSimulated,pb,ReplStr));
+  AssertEquals('$',ReplStr);
+
+  AssertEquals(     'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $2)',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :2)',true,psSimulated,pb,ReplStr));
+  AssertEquals('$',ReplStr);
+
+  AssertEquals(     'update test set 1=$$1 2=$$2 3=$$3 4=$$4 5=$$5 6=$$6 7=$$7 8=$$8 9=$$9 where (id = $$3) and (test=''$test'')',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :par3) and (test=''$test'')',true,psSimulated,pb,ReplStr));
+  AssertEquals('$$',ReplStr);
+
+  AssertEquals(     'update test set 1=$$1 2=$$2 3=$$3 4=$$4 5=$$5 6=$$6 7=$$7 8=$$8 9=$$9 10=$$10 11=$$11 12=$$5 where (id = $$3) and (test=''$test'')',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id = :par3) and (test=''$test'')',true,psSimulated));
+  AssertEquals('$$',ReplStr);
+
+  AssertEquals(     'update test set 1=$$$1 2=$$$2 3=$$$3 4=$$$4 5=$$$5 6=$$$6 7=$$$7 8=$$$8 9=$$$9 10=$$$10 11=$$$11 12=$$$5 where (id$$ = $$$3) and (test$=''$test'')',
+    params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id$$ = :par3) and (test$=''$test'')',true,psSimulated,pb,ReplStr));
+  AssertEquals('$$$',ReplStr);
+
+  AssertEquals(     'select * from table where id = ?',
+    params.ParseSQL('select * from table where id = :id',true,psInterbase));
+
+
+  Params.Free;
+end;
+
+initialization
+  RegisterTest(TTestBasics);
+end.

fcl/dbtests/testdbbasics.pas

@@ -0,0 +1,343 @@
+unit TestDBBasics;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, testdecorator,
+  Classes, SysUtils;
+
+type
+
+  { TTestSQLMechanism }
+
+  { TTestDBBasics }
+
+  TTestDBBasics = class(TTestCase)
+  private
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure RunTest; override;
+  published
+    procedure TestSelectQueryBasics;
+    procedure TestPostOnlyInEditState;
+    procedure TestMove;                    // bug 5048
+    procedure TestActiveBufferWhenClosed;
+    procedure TestEOFBOFClosedDataset;
+    procedure TestdeFieldListChange;
+    procedure TestLastAppendCancel;        // bug 5058
+    procedure TestRecNo;                   // bug 5061
+
+    procedure TestBufDatasetCancelUpdates; //bug 6938
+    procedure TestBufDatasetCancelUpdates1;
+
+  end;
+
+  { TSQLTestSetup }
+
+  TDBBasicsTestSetup = class(TTestSetup)
+  protected
+
+    procedure OneTimeSetup; override;
+    procedure OneTimeTearDown; override;
+  end;
+
+implementation
+
+uses db, toolsunit;
+
+procedure TTestDBBasics.TestSelectQueryBasics;
+var b : TFieldType;
+begin
+  with DBConnector.GetNDataset(1) do
+    begin
+    Open;
+
+    AssertEquals(1,RecNo);
+    AssertEquals(1,RecordCount);
+
+    AssertEquals(2,FieldCount);
+
+    AssertTrue(CompareText('ID',fields[0].FieldName)=0);
+    AssertTrue(CompareText('ID',fields[0].DisplayName)=0); // uitzoeken verschil displaylabel
+    AssertTrue('The datatype of the field ''ID'' is incorrect, it should be ftInteger',ftInteger=fields[0].DataType);
+
+    AssertTrue(CompareText('NAME',fields[1].FieldName)=0);
+    AssertTrue(CompareText('NAME',fields[1].DisplayName)=0); // uitzoeken verschil displaylabel
+    AssertTrue(ftString=fields[1].DataType);
+
+    AssertEquals(1,fields[0].Value);
+    AssertEquals('TestName1',fields[1].Value);
+
+    Close;
+    end;
+end;
+
+procedure TTestDBBasics.TestPostOnlyInEditState;
+begin
+  with DBConnector.GetNDataset(1) do
+    begin
+    open;
+{$IFDEF FPC}
+    AssertException('Post was called in a non-edit state',EDatabaseError,@Post);
+{$ELSE}
+    AssertException('Post was called in a non-edit state',EDatabaseError,Post);
+{$ENDIF}
+    end;
+end;
+
+procedure TTestDBBasics.TestMove;
+var i,count      : integer;
+    aDatasource  : TDataSource;
+    aDatalink    : TDataLink;
+    ABufferCount : Integer;
+
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ABufferCount := 11;
+  aDatalink.BufferCount := ABufferCount;
+  DataEvents := '';
+  for count := 0 to 32 do with DBConnector.GetNDataset(count) do
+    begin
+    aDatasource.DataSet := DBConnector.GetNDataset(count);
+    i := 1;
+    Open;
+    AssertEquals('deUpdateState:0;',DataEvents);
+    DataEvents := '';
+    while not EOF do
+      begin
+      AssertEquals(i,fields[0].AsInteger);
+      AssertEquals('TestName'+inttostr(i),fields[1].AsString);
+      inc(i);
+
+      Next;
+      if (i > ABufferCount) and not EOF then
+        AssertEquals('deCheckBrowseMode:0;deDataSetScroll:-1;',DataEvents)
+      else
+        AssertEquals('deCheckBrowseMode:0;deDataSetScroll:0;',DataEvents);
+      DataEvents := '';
+      end;
+    AssertEquals(count,i-1);
+    close;
+    AssertEquals('deUpdateState:0;',DataEvents);
+    DataEvents := '';
+    end;
+end;
+
+procedure TTestDBBasics.TestdeFieldListChange;
+
+var i,count     : integer;
+    aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  with DBConnector.GetNDataset(1) do
+    begin
+    aDatasource.DataSet := DBConnector.GetNDataset(1);
+    DataEvents := '';
+    open;
+    Fields.add(tfield.Create(DBConnector.GetNDataset(1)));
+    AssertEquals('deUpdateState:0;deFieldListChange:0;',DataEvents);
+    DataEvents := '';
+    fields.Clear;
+    AssertEquals('deFieldListChange:0;',DataEvents)
+    end;
+  aDatasource.Free;
+  aDatalink.Free;
+end;
+
+
+procedure TTestDBBasics.TestActiveBufferWhenClosed;
+begin
+  with DBConnector.GetNDataset(0) do
+    begin
+{$IFDEF fpc}
+    AssertNull(ActiveBuffer);
+{$ENDIF}
+    open;
+    AssertFalse('Activebuffer of an empty dataset shouldn''t be nil',ActiveBuffer = nil);
+    end;
+end;
+
+procedure TTestDBBasics.TestEOFBOFClosedDataset;
+begin
+  with DBConnector.GetNDataset(1) do
+    begin
+    AssertTrue(EOF);
+    AssertTrue(BOF);
+    open;
+    close;
+    AssertTrue(EOF);
+    AssertTrue(BOF);
+    end;
+end;
+
+procedure TTestDBBasics.TestLastAppendCancel;
+
+var count : integer;
+
+begin
+  for count := 0 to 32 do with DBConnector.GetNDataset(count) do
+    begin
+    open;
+
+    Last;
+    Append;
+    Cancel;
+
+    AssertEquals(count,fields[0].asinteger);
+    AssertEquals(count,RecordCount);
+
+    Close;
+
+    end;
+    
+end;
+
+procedure TTestDBBasics.TestRecNo;
+begin
+  with DBConnector.GetNDataset(0) do
+    begin
+    AssertEquals('Failed to get the RecNo from a closed dataset',0,RecNo);
+    AssertEquals(0,RecordCount);
+
+    Open;
+
+    AssertEquals(0,RecordCount);
+    AssertEquals(0,RecNo);
+
+    first;
+    AssertEquals(0,RecordCount);
+    AssertEquals(0,RecNo);
+
+    last;
+    AssertEquals(0,RecordCount);
+    AssertEquals(0,RecNo);
+
+    append;
+    AssertEquals(0,RecNo);
+    AssertEquals(0,RecordCount);
+
+    first;
+    AssertEquals(0,RecNo);
+    AssertEquals(0,RecordCount);
+
+    append;
+    FieldByName('id').AsInteger := 1;
+    AssertEquals(0,RecNo);
+    AssertEquals(0,RecordCount);
+
+    first;
+    AssertEquals(1,RecNo);
+    AssertEquals(1,RecordCount);
+
+    last;
+    AssertEquals(1,RecNo);
+    AssertEquals(1,RecordCount);
+
+    append;
+    FieldByName('id').AsInteger := 1;
+    AssertEquals(0,RecNo);
+    AssertEquals(1,RecordCount);
+
+    Close;
+    end;
+end;
+
+
+procedure TTestDBBasics.SetUp;
+begin
+  DBConnector.InitialiseDatasets;
+end;
+
+procedure TTestDBBasics.TearDown;
+var count : integer;
+begin
+  DBConnector.FreeDatasets;
+end;
+
+procedure TTestDBBasics.RunTest;
+begin
+  inherited RunTest;
+//  inherited RunTest;
+//  inherited RunTest;
+end;
+
+procedure TTestDBBasics.TestBufDatasetCancelUpdates;
+var i : byte;
+begin
+  with DBConnector.GetNDataset(5) as TBufDataset do
+    begin
+    open;
+    next;
+    next;
+
+    edit;
+    FieldByName('name').AsString := 'changed';
+    post;
+    next;
+    delete;
+    
+    CancelUpdates;
+
+    First;
+
+    for i := 1 to 5 do
+      begin
+      AssertEquals(i,fields[0].AsInteger);
+      AssertEquals('TestName'+inttostr(i),fields[1].AsString);
+      Next;
+      end;
+    end;
+end;
+
+procedure TTestDBBasics.TestBufDatasetCancelUpdates1;
+var i : byte;
+begin
+  with DBConnector.GetNDataset(5) as TBufDataset do
+    begin
+    open;
+    next;
+    next;
+
+    delete;
+    insert;
+    FieldByName('id').AsInteger := 100;
+    post;
+
+    CancelUpdates;
+
+    last;
+
+    for i := 5 downto 1 do
+      begin
+      AssertEquals(i,fields[0].AsInteger);
+      AssertEquals('TestName'+inttostr(i),fields[1].AsString);
+      Prior;
+      end;
+    end;
+end;
+
+{ TSQLTestSetup }
+procedure TDBBasicsTestSetup.OneTimeSetup;
+begin
+  InitialiseDBConnector;
+end;
+
+procedure TDBBasicsTestSetup.OneTimeTearDown;
+begin
+  FreeAndNil(DBConnector);
+end;
+
+initialization
+  RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);
+end.

fcl/dbtests/testsqlfieldtypes.pas

@@ -0,0 +1,498 @@
+unit TestSQLFieldTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry,
+  db;
+
+type
+
+  { TTestFieldTypes }
+
+  TTestFieldTypes= class(TTestCase)
+  private
+    procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
+    procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override;
+    procedure RunTest; override;
+  published
+    procedure TestInt;
+    procedure TestString;
+    procedure TestUnlVarChar;
+    procedure TestDate;
+    procedure TestDateTime;       // bug 6925
+    procedure TestFloat;
+
+    procedure TestNullValues;
+    procedure TestParamQuery;
+    procedure TestAggregates;
+  end;
+
+implementation
+
+uses sqldbtoolsunit,toolsunit, variants;
+
+procedure TTestFieldTypes.TestInt;
+
+const
+  testValuesCount = 17;
+  testValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
+
+var
+  i          : byte;
+
+begin
+  CreateTableWithFieldType(ftInteger,'INT');
+  TestFieldDeclaration(ftInteger,4);
+
+  for i := 0 to testValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testValues[i]) + ')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      AssertEquals(testValues[i],fields[0].AsInteger);
+      Next;
+      end;
+    close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestString;
+
+const
+  testValuesCount = 19;
+  testValues : Array[0..testValuesCount-1] of string = (
+    '',
+    'a',
+    'ab',
+    'abc',
+    'abcd',
+    'abcde',
+    'abcdef',
+    'abcdefg',
+    'abcdefgh',
+    'abcdefghi',
+    'abcdefghij',
+    'lMnOpQrStU',
+    '1234567890',
+    '_!@#$%^&*(',
+    ')-;:/?.<>',
+    '~`|{}- =',    // note that there's no \  (backslash) since some db's uses that as escape-character
+    '  WRaP  ',
+    'wRaP  ',
+    ' wRAP'
+  );
+
+var
+  i             : byte;
+
+begin
+  CreateTableWithFieldType(ftString,'VARCHAR(10)');
+  TestFieldDeclaration(ftString,11);
+
+  for i := 0 to testValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      if (dbtype='mysql40') or  (dbtype='mysql41') or (dbtype='mysql50') then
+        AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL automatically trims strings
+      else
+        AssertEquals(testValues[i],fields[0].AsString);
+      Next;
+      end;
+    close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestUnlVarChar;
+
+const
+  testValuesCount = 21;
+  testValues : Array[0..testValuesCount-1] of string = (
+    '',
+    'a',
+    'ab',
+    'abc',
+    'abcd',
+    'abcde',
+    'abcdef',
+    'abcdefg',
+    'abcdefgh',
+    'abcdefghi',
+    'abcdefghij',
+    'lMnOpQrStU',
+    '1234567890',
+    '_!@#$%^&*(',
+    ')-;:/?.<>',
+    '~`|{}- =',
+    '  WRaP  ',
+    'wRaP  ',
+    ' wRAP',
+    '0123456789',
+    'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
+    + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
+  );
+
+var
+  i             : byte;
+
+begin
+  if dbtype <> 'postgresql' then exit; // Only postgres accept this type-definition
+  CreateTableWithFieldType(ftString,'VARCHAR');
+  TestFieldDeclaration(ftString,dsMaxStringSize+1);
+
+  for i := 0 to testValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      AssertEquals(testValues[i],fields[0].AsString);
+      Next;
+      end;
+    close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestDate;
+
+const
+  testValuesCount = 18;
+  testValues : Array[0..testValuesCount-1] of string = (
+    '2000-01-01',
+    '1999-12-31',
+    '2004-02-29',
+    '2004-03-01',
+    '1991-02-28',
+    '1991-03-01',
+    '2040-10-16',
+    '1977-09-29',
+    '1800-03-30',
+    '1650-05-10',
+    '1754-06-04',
+    '0904-04-12',
+    '0199-07-09',
+    '0001-01-01',
+    '1899-12-29',
+    '1899-12-30',
+    '1899-12-31',
+    '1900-01-01'
+  );
+
+var
+  i             : byte;
+
+begin
+  CreateTableWithFieldType(ftDate,'DATE');
+  TestFieldDeclaration(ftDate,8);
+
+  for i := 0 to testValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+
+//  TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime));
+      Next;
+      end;
+    close;
+    end;
+
+end;
+
+procedure TTestFieldTypes.TestDateTime;
+
+const
+  testValuesCount = 31;
+  testValues : Array[0..testValuesCount-1] of string = (
+    '2000-01-01',
+    '1999-12-31',
+    '2004-02-29',
+    '2004-03-01',
+    '1991-02-28',
+    '1991-03-01',
+    '1977-09-29',
+    '2000-01-01 10:00:00',
+    '2000-01-01 23:59:59',
+    '1994-03-06 11:54:30',
+    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
+    '1400-02-03 12:21:53',
+    '0354-11-20 21:25:15',
+    '1333-02-03 21:44:21',
+    '1800-03-30',
+    '1650-05-10',
+    '1754-06-04',
+    '0904-04-12',
+    '0199-07-09',
+    '0001-01-01',
+    '1899-12-29',
+    '1899-12-30',
+    '1899-12-31',
+    '1900-01-01',
+    '1899-12-30 18:00:51',
+    '1899-12-30 04:00:51',
+    '1899-12-29 04:00:51',
+    '1899-12-29 18:00:51',
+    '1903-04-02 01:04:02',
+    '1815-09-24 03:47:22',
+    '2100-01-01 01:01:01'
+  );
+
+var
+  i, corrTestValueCount : byte;
+
+begin
+  CreateTableWithFieldType(ftDateTime,'TIMESTAMP');
+  TestFieldDeclaration(ftDateTime,8);
+  
+  if dbtype='mysql40' then corrTestValueCount := testValuesCount-21
+    else corrTestValueCount := testValuesCount;
+
+  for i := 0 to corrTestValueCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to corrTestValueCount-1 do
+      begin
+      if length(testValues[i]) < 12 then
+        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd',fields[0].AsDateTime))
+      else
+        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss',fields[0].AsDateTime));
+      Next;
+      end;
+    close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestFloat;
+const
+  testValuesCount = 21;
+  testValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
+
+var
+  i          : byte;
+
+begin
+  CreateTableWithFieldType(ftFloat,'FLOAT');
+  TestFieldDeclaration(ftFloat,sizeof(double));
+
+  for i := 0 to testValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + floattostr(testValues[i]) + ')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      AssertEquals(testValues[i],fields[0].AsFloat);
+      Next;
+      end;
+    close;
+    end;
+end;
+
+procedure TTestFieldTypes.TestNullValues;
+begin
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FIELD1) values (1)');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    sql.clear;
+    sql.append('select * from FPDEV2');
+    open;
+    AssertEquals(1,FieldByName('FIELD1').AsInteger);
+    AssertTrue('Null-values test failed',FieldByName('FIELD2').IsNull);
+    close;
+    end;
+end;
+
+
+procedure TTestFieldTypes.TestParamQuery;
+begin
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT, FIELD3 INT, DECOY VARCHAR(30))');
+
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    sql.clear;
+    sql.append('insert into FPDEV2 (field1) values (:field1)');
+    Params.ParamByName('field1').AsInteger := 1;
+    ExecSQL;
+
+    sql.clear;
+    sql.append('insert into FPDEV2 (field1,field2,decoy) values (:field1,:field2,''decoytest'')');
+    Params.ParamByName('field1').AsInteger := 2;
+    Params.ParamByName('field2').DataType := ftInteger;
+    Params.ParamByName('field2').Value := Null;
+    ExecSQL;
+
+    sql.clear;
+    sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field3)');
+    Params.ParamByName('field1').AsInteger := 3;
+    Params.ParamByName('field2').AsInteger := 2;
+    Params.ParamByName('field3').AsInteger := 3;
+    ExecSQL;
+
+    sql.clear;
+    sql.append('insert into FPDEV2 (field1,field2,field3,decoy) values (:field1,:field2,:field3,'':decoy ::test $decoy2 $$2'')');
+    Params.ParamByName('field1').AsInteger := 4;
+    Params.ParamByName('field2').AsInteger := 2;
+    Params.ParamByName('field3').AsInteger := 3;
+    ExecSQL;
+
+    sql.clear;
+    sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field1)');
+    Params.ParamByName('field1').AsInteger := 5;
+    Params.ParamByName('field2').AsInteger := 2;
+    ExecSQL;
+    
+    sql.clear;
+    sql.append('select * from FPDEV2 order by FIELD1');
+    open;
+    AssertEquals(1,FieldByName('FIELD1').asinteger);
+    AssertTrue(FieldByName('FIELD2').IsNull);
+    AssertTrue(FieldByName('FIELD3').IsNull);
+    AssertTrue(FieldByName('DECOY').IsNull);
+    next;
+    AssertEquals(2,FieldByName('FIELD1').asinteger);
+    AssertTrue(FieldByName('FIELD2').IsNull);
+    AssertTrue(FieldByName('FIELD3').IsNull);
+    AssertEquals('decoytest',FieldByName('DECOY').AsString);
+    next;
+    AssertEquals(3,FieldByName('FIELD1').asinteger);
+    AssertEquals(2,FieldByName('FIELD2').asinteger);
+    AssertEquals(3,FieldByName('FIELD3').asinteger);
+    AssertTrue(FieldByName('DECOY').IsNull);
+    next;
+    AssertEquals(4,FieldByName('FIELD1').asinteger);
+    AssertEquals(2,FieldByName('FIELD2').asinteger);
+    AssertEquals(3,FieldByName('FIELD3').asinteger);
+    AssertEquals(':decoy ::test $decoy2 $$2',FieldByName('DECOY').AsString);
+    next;
+    AssertEquals(5,FieldByName('FIELD1').asinteger);
+    AssertEquals(2,FieldByName('FIELD2').asinteger);
+    AssertEquals(5,FieldByName('FIELD3').asinteger);
+    AssertTrue(FieldByName('DECOY').IsNull);
+    close;
+
+    end;
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+
+end;
+
+procedure TTestFieldTypes.TestAggregates;
+begin
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
+
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    sql.clear;
+    sql.append('select count(*) from FPDEV2');
+    open;
+    AssertEquals(4,Fields[0].AsInteger);
+    close;
+
+    sql.clear;
+    sql.append('select sum(FIELD1) from FPDEV2');
+    open;
+    AssertEquals(10,Fields[0].AsInteger);
+    close;
+
+    sql.clear;
+    sql.append('select avg(FIELD2) from FPDEV2');
+    open;
+    AssertEquals(3,Fields[0].AsInteger);
+    close;
+
+    end;
+
+end;
+
+procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
+  ASQLTypeDecl: string);
+begin
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
+
+// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+end;
+
+procedure TTestFieldTypes.TestFieldDeclaration(ADatatype: TFieldType;
+  ADataSize: integer);
+begin
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    SQL.Clear;
+    SQL.Add('select * from FPDEV2');
+
+    Open;
+    AssertEquals(1,FieldCount);
+    AssertTrue(CompareText('FT',fields[0].FieldName)=0);
+    AssertEquals(ADataSize,fields[0].DataSize);
+    AssertTrue(ADatatype=fields[0].DataType);
+    Close;
+    end;
+end;
+
+procedure TTestFieldTypes.SetUp; 
+begin
+  InitialiseDBConnector;
+end;
+
+procedure TTestFieldTypes.TearDown; 
+begin
+  if assigned(DBConnector) then
+    TSQLDBConnector(DBConnector).Transaction.Rollback;
+  FreeAndNil(DBConnector);
+end;
+
+procedure TTestFieldTypes.RunTest;
+begin
+  if (dbtype = 'interbase') or
+     (dbtype = 'mysql50') or
+     (dbtype = 'mysql40') or
+     (dbtype = 'mysql41') or
+     (dbtype = 'postgresql') then
+    inherited RunTest;
+end;
+
+initialization
+  RegisterTest(TTestFieldTypes);
+end.
+

fcl/dbtests/toolsunit.pas

@@ -0,0 +1,137 @@
+unit ToolsUnit;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+{$I settings.inc}
+
+interface
+
+uses
+  Classes, SysUtils, DB;
+  
+Const MaxDataSet = 35;
+  
+type
+
+  { TDBConnector }
+
+  TDBConnector = class(TObject)
+     private
+       FDatasets : array[0..MaxDataset] of TDataset;
+     protected
+       Procedure FreeNDataset(var ds : TDataset); virtual; abstract;
+       Function CreateNDataset(n : integer) : TDataset; virtual; abstract;
+     public
+       Function GetNDataset(n : integer) : TDataset; virtual;
+       procedure InitialiseDatasets; virtual;
+       procedure FreeDatasets; virtual;
+     end;
+
+
+{ TTestDataLink }
+
+  TTestDataLink = class(TDataLink)
+     protected
+{$IFDEF fpc}
+       procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
+{$ELSE}
+       procedure DataEvent(Event: TDataEvent; Info: longint); override;
+{$ENDIF}
+
+     end;
+
+const
+  DataEventnames : Array [TDataEvent] of String[19] =
+    ('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
+     'deLayoutChange', 'deUpdateRecord', 'deUpdateState', 'deCheckBrowseMode',
+     'dePropertyChange', 'deFieldListChange', 'deFocusControl' ,'deParentScroll'
+{$IFNDEF VER2_0_2}, 'deConnectChange','deReconcileError','deDisabledStateChange'{$ENDIF}
+    );
+
+var dbtype,
+    dbname,
+    dbuser,
+    dbhostname,
+    dbpassword      : string;
+
+    DBConnector     : TDBConnector;
+    
+    DataEvents      : string;
+
+procedure InitialiseDBConnector;
+
+implementation
+
+uses
+{$IFDEF SQLDB_AVAILABLE}
+  sqldbtoolsunit,
+{$ENDIF}
+{$IFDEF DBF_AVAILABLE}
+  dbftoolsunit,
+{$ENDIF}
+  inifiles;
+
+procedure ReadIniFile;
+
+var IniFile : TIniFile;
+begin
+  IniFile := TIniFile.Create(getcurrentdir + PathDelim + 'database.ini');
+  dbtype := IniFile.ReadString('Database','Type','');
+  dbname := IniFile.ReadString('Database','Name','');
+  dbuser := IniFile.ReadString('Database','User','');
+  dbhostname := IniFile.ReadString('Database','Hostname','');
+  dbpassword := IniFile.ReadString('Database','Password','');
+  IniFile.Free;
+end;
+
+procedure InitialiseDBConnector;
+
+begin
+  ReadIniFile;
+  if (1 <> 1) then begin end
+{$IFDEF SQLDB_AVAILABLE}
+  else if (dbtype = 'interbase') or (dbtype = 'postgresql') or (dbtype = 'mysql50') or (dbtype = 'mysql40') or (dbtype = 'mysql41')  then DBConnector := TSQLDBConnector.Create
+{$ENDIF}
+{$IFDEF DBF_AVAILABLE}
+  else if dbtype = 'dbf' then DBConnector := TDBFDBConnector.Create
+{$ENDIF}
+  else Raise Exception.Create('Invalid database-type specified');
+end;
+
+{ TTestDataLink }
+
+{$IFDEF FPC}
+procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
+{$ELSE}
+procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Longint);
+{$ENDIF}
+begin
+  DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';';
+  inherited DataEvent(Event, Info);
+end;
+
+{ TDBConnector }
+
+function TDBConnector.GetNDataset(n: integer): TDataset;
+begin
+  Result := FDatasets[n];
+end;
+
+procedure TDBConnector.InitialiseDatasets;
+var count : integer;
+begin
+  for count := 0 to MaxDataSet do
+    FDatasets[count] := CreateNDataset(count);
+end;
+
+procedure TDBConnector.FreeDatasets;
+var count : integer;
+begin
+  for count := 0 to MaxDataSet do if assigned(FDatasets[count]) then
+    FreeNDataset(FDatasets[count]);
+end;
+
+end.
+

fcl/go32v2/pipes.inc

@@ -15,7 +15,7 @@
 
 // No pipes under dos, sorry...
 
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
+Function CreatePipeHandles (Var Inhandle,OutHandle : THandle) : Boolean;
 
 begin
   Result := False;

fcl/image/fpwritexpm.pp

@@ -76,6 +76,7 @@ end;
 procedure TFPWriterXPM.InternalWrite (Str:TStream; Img:TFPCustomImage);
 var p, l : TStringList;
     c, len, r, t : integer;
+    TmpPalette, Palette: TFPPalette;
   procedure BuildPaletteStrings;
   var r,c,e : integer;
     procedure MakeCodes (const head:string; charplace:integer);
@@ -85,12 +86,13 @@ var p, l : TStringList;
       dec (charplace);
       while (r <= e) and (c >= 0) do
         begin
-        if Charplace = 1 then
+        if Charplace > 0 then
           MakeCodes (head+PalChars[r],charplace)
-        else
+        else begin
           p.Add (head+PalChars[r]);
+          dec(c);
+        end;
         inc (r);
-        dec(c);
         end;
     end;
   begin
@@ -98,7 +100,7 @@ var p, l : TStringList;
     len := 1;
     e := length(PalChars);
     r := e;
-    c := img.palette.count;
+    c := Palette.count;
     while (r <= c) do
       begin
       inc (len);
@@ -123,25 +125,35 @@ var s : string;
 begin
   l := TStringList.Create;
   p := TStringList.Create;
+  TmpPalette := nil;
   try
     l.Add ('/* XPM */');
     l.Add ('static char *graphic[] = {');
-    c := img.palette.count;
+    Palette := img.palette;
+    if not Assigned(Palette) then begin
+      TmpPalette := TFPPalette.Create(0);
+      TmpPalette.Build(Img);
+      Palette := TmpPalette;
+    end;
+    c := Palette.count;
     BuildPaletteStrings;
     l.add (format('"%d %d %d %d",',[img.width,img.height,c,len]));
     InitConsts;
     for r := 0 to c-1 do
       begin
-      if img.palette[r] <> colTransparent then
-        l.Add (format('"%s c #%s",',[p[r],ColorToHex(img.palette.color[r])]))
+      if Palette[r] <> colTransparent then
+        l.Add (format('"%s c #%s",',[p[r],ColorToHex(Palette.color[r])]))
       else
         l.Add (format('"%s c None",',[p[r]]));
       end;
     for r := 0 to img.Height-1 do
       begin
-      s := p[img.pixels[0,r]];
-      for t := 1 to img.Width-1 do
-        s := s + p[img.pixels[t,r]];
+      s := '';
+      for t := 0 to img.Width-1 do
+        if Assigned(TmpPalette) then
+          s := s + p[TmpPalette.IndexOf(img.Colors[t,r])]
+        else
+          s := s + p[img.pixels[t,r]];
       s := '"'+s+'"';
       if r < img.Height-1 then
         s := s + ',';
@@ -149,6 +161,7 @@ begin
       end;
     l.Add ('};');
   finally
+    TmpPalette.Free;
     l.SaveToStream (Str);
     p.Free;
     l.Free;

fcl/inc/zstream.pp

@@ -312,6 +312,8 @@ end;
 
 destructor TDecompressionStream.Destroy;
 begin
+  if FZRec.avail_in <> 0 then
+    Source.Seek(-FZRec.avail_in, soFromCurrent);
   inflateEnd(FZRec);
   inherited Destroy;
 end;
@@ -345,7 +347,11 @@ begin
       FStrmPos := Source.Position;
       Progress(Self);
     end;
-    DeCompressionCheck(inflate(FZRec, 0));
+    if DeCompressionCheck(inflate(FZRec, 0)) = Z_STREAM_END then
+	begin
+	  Result := Count - FZRec.avail_out;
+	  Exit;
+	end;
   end;
   Result := Count;
 end;

fcl/passrc/pastree.pp

@@ -804,7 +804,7 @@ begin
   inherited Destroy;
 end;
 
-function TPasProcedureType.TypeName: string;
+class function TPasProcedureType.TypeName: string;
 begin
   Result := 'procedure';
 end;
@@ -833,7 +833,8 @@ begin
   inherited Destroy;
 end;
 
-function TPasFunctionType.TypeName: string;
+
+class function TPasFunctionType.TypeName: string;
 begin
   Result := 'function';
 end;

fcl/xml/xmlwrite.pp

@@ -3,8 +3,9 @@
 
     XML writing routines
     Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
+    Modified in 2006 by Sergei Gorelkin, [email protected]
 
-    See the file COPYING.modifiedLGPL, included in this distribution,
+    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,
@@ -16,8 +17,11 @@
 
 unit XMLWrite;
 
+{$ifdef fpc}
 {$MODE objfpc}
+{$INLINE ON}
 {$H+}
+{$endif}
 
 interface
 
@@ -39,148 +43,143 @@ implementation
 uses SysUtils;
 
 // -------------------------------------------------------------------
-//   Writers for the different node types
+//   Text file and TStream support
 // -------------------------------------------------------------------
 
-procedure WriteElement(node: TDOMNode); forward;
-procedure WriteAttribute(node: TDOMNode); forward;
-procedure WriteText(node: TDOMNode); forward;
-procedure WriteCDATA(node: TDOMNode); forward;
-procedure WriteEntityRef(node: TDOMNode); forward;
-procedure WriteEntity(node: TDOMNode); forward;
-procedure WritePI(node: TDOMNode); forward;
-procedure WriteComment(node: TDOMNode); forward;
-procedure WriteDocument(node: TDOMNode); forward;
-procedure WriteDocumentType(node: TDOMNode); forward;
-procedure WriteDocumentFragment(node: TDOMNode); forward;
-procedure WriteNotation(node: TDOMNode); forward;
-
-
 type
-  TWriteNodeProc = procedure(node: TDOMNode);
+  TOutputProc = procedure(const Buffer; Count: Longint) of object;
+  TCharacters = set of Char;
+  TSpecialCharCallback = procedure(c: Char) of object;
+
+  TXMLWriter = class(TObject)  // (TAbstractDOMVisitor)?
+  private
+    FInsideTextNode: Boolean;
+    FIndent: string;
+    FIndentCount: Integer;
+    procedure IncIndent; {$IFDEF FPC} inline; {$ENDIF}
+    procedure DecIndent; {$IFDEF FPC} inline; {$ENDIF}
+    procedure wrtStr(const s: string);
+    procedure wrtChr(c: char);
+    procedure wrtLineEnd; {$IFDEF FPC} inline; {$ENDIF}
+    procedure wrtIndent;
+    procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
+      const SpecialCharCallback: TSpecialCharCallback);
+    procedure AttrSpecialCharCallback(c: Char);
+    procedure TextNodeSpecialCharCallback(c: Char);
+  protected
+    Procedure Write(Const Buffer; Count : Longint); virtual;Abstract;
+    Procedure Writeln(Const Buffer; Count : Longint); virtual;
+    procedure WriteNode(Node: TDOMNode);
+    procedure VisitDocument(Node: TDOMNode);  // override;
+    procedure VisitElement(Node: TDOMNode);
+    procedure VisitText(Node: TDOMNode);
+    procedure VisitCDATA(Node: TDOMNode);
+    procedure VisitComment(Node: TDOMNode);
+    procedure VisitFragment(Node: TDOMNode);
+    procedure VisitAttribute(Node: TDOMNode);
+    procedure VisitEntity(Node: TDOMNode);
+    procedure VisitEntityRef(Node: TDOMNode);
+    procedure VisitDocumentType(Node: TDOMNode);
+    procedure VisitPI(Node: TDOMNode);
+    procedure VisitNotation(Node: TDOMNode);
+  end;
 
-const
-  WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
-    (@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
-     @WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
-     @WriteDocumentFragment, @WriteNotation);
+  TTextXMLWriter = Class(TXMLWriter)
+  Private
+    F : ^Text;
+  Protected  
+    Procedure Write(Const Buffer; Count : Longint);override;
+  Public  
+    procedure WriteXML(Root: TDomNode; var AFile: Text); overload;
+  end;
+  
+  TStreamXMLWriter = Class(TXMLWriter)
+  Private
+    F : TStream;
+  Protected  
+    Procedure Write(Const Buffer; Count : Longint);override;
+  Public  
+    procedure WriteXML(Root: TDomNode; AStream : TStream); overload;
+  end;
 
-procedure WriteNode(node: TDOMNode);
+{ ---------------------------------------------------------------------
+    TTextXMLWriter
+  ---------------------------------------------------------------------}
+  
+
+procedure TTextXMLWriter.Write(const Buffer; Count: Longint);
+var
+  s: string;
 begin
-  WriteProcs[node.NodeType](node);
+  if Count>0 then
+    begin
+    SetString(s, PChar(Buffer), Count);
+    system.Write(f^, s);
+    end;
 end;
 
+{ ---------------------------------------------------------------------
+    TStreamXMLWriter
+  ---------------------------------------------------------------------}
 
-// -------------------------------------------------------------------
-//   Text file and TStream support
-// -------------------------------------------------------------------
-
-type
-  TOutputProc = procedure(const Buffer; Count: Longint);
-
-threadvar
-  f: ^Text;
-  stream: TStream;
-  wrt, wrtln: TOutputProc;
-  InsideTextNode: Boolean;
-
-procedure Text_Write(const Buffer; Count: Longint);
-var s: string;
+procedure TStreamXMLWriter.Write(const Buffer; Count: Longint);
 begin
-  if Count>0 then begin
-    SetLength(s,Count);
-    System.Move(Buffer,s[1],Count);
-    Write(f^, s);
-  end;
+  if Count > 0 then
+    F.Write(Buffer, Count);
 end;
 
-procedure Text_WriteLn(const Buffer; Count: Longint);
-var s: string;
-begin
-  if Count>0 then begin
-    SetLength(s,Count);
-    System.Move(Buffer,s[1],Count);
-    writeln(f^, s);
-  end;
-end;
 
-procedure Stream_Write(const Buffer; Count: Longint);
-begin
-  if Count > 0 then begin
-    stream.Write(Buffer, Count);
-  end;
-end;
+{ ---------------------------------------------------------------------
+    TXMLWriter
+  ---------------------------------------------------------------------}
 
-procedure Stream_WriteLn(const Buffer; Count: Longint);
-begin
-  if Count > 0 then begin
-    stream.Write(Buffer, Count);
-    stream.WriteByte(10);
-  end;
-end;
+Procedure TXMLWriter.Writeln(Const Buffer; Count : Longint); 
 
-procedure wrtStr(const s: string);
 begin
-  if s<>'' then
-    wrt(s[1],length(s));
+  Write(buffer,count);
+  Wrtstr(slinebreak);
 end;
 
-procedure wrtStrLn(const s: string);
+
+procedure TXMLWriter.wrtStr(const s: string);
 begin
   if s<>'' then
-    wrtln(s[1],length(s));
+    write(s[1],length(s));
 end;
 
-procedure wrtChr(c: char);
+procedure TXMLWriter.wrtChr(c: char);
 begin
-  wrt(c,1);
+  write(c,1);
 end;
 
-procedure wrtLineEnd;
+procedure TXMLWriter.wrtLineEnd;
 begin
-  wrt(#10,1);
+  wrtstr(slinebreak);
 end;
 
-// -------------------------------------------------------------------
-//   Indent handling
-// -------------------------------------------------------------------
-
-threadvar
-  Indent: String;
-  IndentCount: integer;
-
-procedure wrtIndent;
-var i: integer;
+procedure TXMLWriter.wrtIndent;
+var
+  I: Integer;
 begin
-  for i:=1 to IndentCount do
-    wrtStr(Indent);
+  for I:=1 to FIndentCount do
+    wrtStr(FIndent);
 end;
 
-procedure IncIndent;
+procedure TXMLWriter.IncIndent;
 begin
-  inc(IndentCount);
+  Inc(FIndentCount);
 end;
 
-procedure DecIndent;
+procedure TXMLWriter.DecIndent;
 begin
-  if IndentCount>0 then dec(IndentCount);
+  if FIndentCount>0 then dec(FIndentCount);
 end;
 
-
-// -------------------------------------------------------------------
-//   String conversion
-// -------------------------------------------------------------------
-
-type
-  TCharacters = set of Char;
-  TSpecialCharCallback = procedure(c: Char);
-
 const
   AttrSpecialChars = ['<', '>', '"', '&'];
   TextSpecialChars = ['<', '>', '&'];
 
-
-procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
+procedure TXMLWriter.ConvWrite(const s: String; const SpecialChars: TCharacters;
   const SpecialCharCallback: TSpecialCharCallback);
 var
   StartPos, EndPos: Integer;
@@ -191,30 +190,33 @@ begin
   begin
     if s[EndPos] in SpecialChars then
     begin
-      wrt(s[StartPos],EndPos - StartPos);
+      write(s[StartPos],EndPos - StartPos);
       SpecialCharCallback(s[EndPos]);
       StartPos := EndPos + 1;
     end;
     Inc(EndPos);
   end;
   if StartPos <= length(s) then
-    wrt(s[StartPos], EndPos - StartPos);
+    write(s[StartPos], EndPos - StartPos);
 end;
 
-procedure AttrSpecialCharCallback(c: Char);
+procedure TXMLWriter.AttrSpecialCharCallback(c: Char);
 const
   QuotStr = '&quot;';
   AmpStr = '&amp;';
+  ltStr = '&lt;';
 begin
   if c = '"' then
     wrtStr(QuotStr)
   else if c = '&' then
     wrtStr(AmpStr)
+  else if c = '<' then
+    wrtStr(ltStr)
   else
-    wrt(c,1);
+    write(c,1);
 end;
 
-procedure TextnodeSpecialCharCallback(c: Char);
+procedure TXMLWriter.TextnodeSpecialCharCallback(c: Char);
 const
   ltStr = '&lt;';
   gtStr = '&gt;';
@@ -227,362 +229,261 @@ begin
   else if c = '&' then
     wrtStr(AmpStr)
   else
-    wrt(c,1);
+    write(c,1);
+end;
+
+procedure TXMLWriter.WriteNode(node: TDOMNode);
+begin
+  // Must be: node.Accept(Self);
+  case node.NodeType of
+    ELEMENT_NODE:                VisitElement(node);
+    ATTRIBUTE_NODE:              VisitAttribute(node);
+    TEXT_NODE:                   VisitText(node);
+    CDATA_SECTION_NODE:          VisitCDATA(node);
+    ENTITY_REFERENCE_NODE:       VisitEntityRef(node);
+    ENTITY_NODE:                 VisitEntity(node);
+    PROCESSING_INSTRUCTION_NODE: VisitPI(node);
+    COMMENT_NODE:                VisitComment(node);
+    DOCUMENT_NODE:               VisitDocument(node);
+    DOCUMENT_TYPE_NODE:          VisitDocumentType(node);
+    DOCUMENT_FRAGMENT_NODE:      VisitFragment(node);
+    NOTATION_NODE:               VisitNotation(node);
+  end;
 end;
 
 
-// -------------------------------------------------------------------
-//   Node writers implementations
-// -------------------------------------------------------------------
-
-procedure WriteElement(node: TDOMNode);
+procedure TXMLWriter.VisitElement(node: TDOMNode);
 var
   i: Integer;
   attr, child: TDOMNode;
   SavedInsideTextNode: Boolean;
-  s: String;
+  s: DOMString;
 begin
-  if not InsideTextNode then
+  if not FInsideTextNode then
     wrtIndent;
   wrtChr('<');
-  wrtStr(node.NodeName);
+  wrtStr(UTF8Encode(node.NodeName));
   for i := 0 to node.Attributes.Length - 1 do
   begin
     attr := node.Attributes.Item[i];
     wrtChr(' ');
-    wrtStr(attr.NodeName);
+    wrtStr(UTF8Encode(attr.NodeName));
     wrtChr('=');
     s := attr.NodeValue;
     // !!!: Replace special characters in "s" such as '&', '<', '>'
     wrtChr('"');
-    ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback);
+    ConvWrite(UTF8Encode(s), AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
     wrtChr('"');
   end;
   Child := node.FirstChild;
   if Child = nil then begin
     wrtChr('/');
     wrtChr('>');
-    if not InsideTextNode then wrtLineEnd;
+    if not FInsideTextNode then wrtLineEnd;
   end else
   begin
-    SavedInsideTextNode := InsideTextNode;
+    SavedInsideTextNode := FInsideTextNode;
     wrtChr('>');
-    if not (InsideTextNode or Child.InheritsFrom(TDOMText)) then
+    if not (FInsideTextNode or Child.InheritsFrom(TDOMText)) then
       wrtLineEnd;
     IncIndent;
     repeat
       if Child.InheritsFrom(TDOMText) then
-        InsideTextNode := True;
+        FInsideTextNode := True
+      else                      // <-- fix case when CDATA is first child
+        FInsideTextNode := False;
       WriteNode(Child);
       Child := Child.NextSibling;
     until child = nil;
     DecIndent;
-    if not InsideTextNode then
+    if not FInsideTextNode then
       wrtIndent;
-    InsideTextNode := SavedInsideTextNode;
+    FInsideTextNode := SavedInsideTextNode;
     wrtChr('<');
     wrtChr('/');
-    wrtStr(node.NodeName);
+    wrtStr(UTF8Encode(node.NodeName));
     wrtChr('>');
-    if not InsideTextNode then
+    if not FInsideTextNode then
       wrtLineEnd;
   end;
 end;
 
-procedure WriteAttribute(node: TDOMNode);
-begin
-  if node=nil then ;
-end;
-
-procedure WriteText(node: TDOMNode);
+procedure TXMLWriter.VisitText(node: TDOMNode);
 begin
-  ConvWrite(node.NodeValue, TextSpecialChars, @TextnodeSpecialCharCallback);
-  if node=nil then ;
+  ConvWrite(UTF8Encode(node.NodeValue), TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback);
 end;
 
-procedure WriteCDATA(node: TDOMNode);
+procedure TXMLWriter.VisitCDATA(node: TDOMNode);
 begin
-  if not InsideTextNode then
-    wrtStr('<![CDATA[' + node.NodeValue + ']]>')
+  if not FInsideTextNode then
+    wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>')
   else begin
     wrtIndent;
-    wrtStrln('<![CDATA[' + node.NodeValue + ']]>')
+    wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>');
+    wrtLineEnd;
   end;
 end;
 
-procedure WriteEntityRef(node: TDOMNode);
+procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
 begin
   wrtChr('&');
-  wrtStr(node.NodeName);
+  wrtStr(UTF8Encode(node.NodeName));
   wrtChr(';');
 end;
 
-procedure WriteEntity(node: TDOMNode);
+procedure TXMLWriter.VisitEntity(node: TDOMNode);
 begin
-  if node=nil then ;
+
 end;
 
-procedure WritePI(node: TDOMNode);
+procedure TXMLWriter.VisitPI(node: TDOMNode);
 begin
-  if not InsideTextNode then wrtIndent;
-  wrtChr('<'); wrtChr('!');
-  wrtStr(TDOMProcessingInstruction(node).Target);
+  if not FInsideTextNode then wrtIndent;
+  wrtChr('<'); wrtChr('?');
+  wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Target));
   wrtChr(' ');
-  wrtStr(TDOMProcessingInstruction(node).Data);
-  wrtChr('>');
-  if not InsideTextNode then wrtLineEnd;
+  wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Data));
+  wrtChr('?'); wrtChr('>');
+  if not FInsideTextNode then wrtLineEnd;
 end;
 
-procedure WriteComment(node: TDOMNode);
+procedure TXMLWriter.VisitComment(node: TDOMNode);
 begin
-  if not InsideTextNode then wrtIndent;
+  if not FInsideTextNode then wrtIndent;
   wrtStr('<!--');
-  wrtStr(node.NodeValue);
+  wrtStr(UTF8Encode(node.NodeValue));
   wrtStr('-->');
-  if not InsideTextNode then wrtLineEnd;
-end;
-
-procedure WriteDocument(node: TDOMNode);
-begin
-  if node=nil then ;
-end;
-
-procedure WriteDocumentType(node: TDOMNode);
-begin
-  if node=nil then ;
-end;
-
-procedure WriteDocumentFragment(node: TDOMNode);
-begin
-  if node=nil then ;
-end;
-
-procedure WriteNotation(node: TDOMNode);
-begin
-  if node=nil then ;
-end;
-
-
-procedure InitWriter;
-begin
-  InsideTextNode := False;
-  SetLength(Indent, 0);
+  if not FInsideTextNode then wrtLineEnd;
 end;
 
-procedure RootWriter(doc: TXMLDocument);
+procedure TXMLWriter.VisitDocument(node: TDOMNode);
 var
-  Child: TDOMNode;
+  child: TDOMNode;
 begin
-  InitWriter;
   wrtStr('<?xml version="');
-  if Length(doc.XMLVersion) > 0 then
-    ConvWrite(doc.XMLVersion, AttrSpecialChars, @AttrSpecialCharCallback)
+  if Length(TXMLDocument(node).XMLVersion) > 0 then
+    ConvWrite(TXMLDocument(node).XMLVersion, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback)
   else
     wrtStr('1.0');
   wrtChr('"');
-  if Length(doc.Encoding) > 0 then
+  if Length(TXMLDocument(node).Encoding) > 0 then
   begin
     wrtStr(' encoding="');
-    ConvWrite(doc.Encoding, AttrSpecialChars, @AttrSpecialCharCallback);
+    ConvWrite(TXMLDocument(node).Encoding, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
     wrtStr('"');
   end;
-  wrtStrln('?>');
+  wrtStr('?>');
+  wrtLineEnd;
 
-  if Length(doc.StylesheetType) > 0 then
+  if Length(TXMLDocument(node).StylesheetType) > 0 then
   begin
     wrtStr('<?xml-stylesheet type="');
-    ConvWrite(doc.StylesheetType, AttrSpecialChars, @AttrSpecialCharCallback);
+    ConvWrite(TXMLDocument(node).StylesheetType, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
     wrtStr('" href="');
-    ConvWrite(doc.StylesheetHRef, AttrSpecialChars, @AttrSpecialCharCallback);
-    wrtStrln('"?>');
+    ConvWrite(TXMLDocument(node).StylesheetHRef, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
+    wrtStr('"?>');
+    wrtLineEnd;
   end;
 
-  Indent := '  ';
-  IndentCount := 0;
+  FIndent := '  ';
+  FIndentCount := 0;
 
-  child := doc.FirstChild;
+  child := node.FirstChild;
   while Assigned(Child) do
   begin
     WriteNode(Child);
     Child := Child.NextSibling;
   end;
+
+  if node=nil then ;
 end;
 
+procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
+begin
+
+end;
 
-procedure WriteXMLMemStream(doc: TXMLDocument);
-// internally used by the WriteXMLFile procedures
+procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
 begin
-  Stream:=TMemoryStream.Create;
-  WriteXMLFile(doc,Stream);
-  Stream.Position:=0;
+
 end;
 
-// -------------------------------------------------------------------
-//   Interface implementation
-// -------------------------------------------------------------------
+procedure TXMLWriter.VisitFragment(Node: TDOMNode);
+begin
+  VisitElement(Node);
+end;
 
-{$IFDEF FPC}
-    {$DEFINE UsesFPCWidestrings}
-{$ENDIF}
+procedure TXMLWriter.VisitNotation(Node: TDOMNode);
+begin
 
-{$IFDEF UsesFPCWidestrings}
+end;
 
-{procedure SimpleWide2AnsiMove(source:pwidechar;dest:pchar;len:sizeint);
-var
-  i : sizeint;
+
+procedure TStreamXMLWriter.WriteXML(Root: TDOMNode; AStream: TStream);
 begin
-  for i:=1 to len do
-   begin
-     if word(source^)<256 then
-      dest^:=char(word(source^))
-     else
-      dest^:='?';
-     inc(dest);
-     inc(source);
-   end;
+  F:=AStream;
+  WriteNode(Root);
 end;
 
-procedure SimpleAnsi2WideMove(source:pchar;dest:pwidechar;len:sizeint);
-var
-  i : sizeint;
+procedure TTextXMLWriter.WriteXML(Root: TDOMNode; var AFile: Text);
 begin
-  for i:=1 to len do
-   begin
-     dest^:=widechar(byte(source^));
-     inc(dest);
-     inc(source);
-   end;
-end;}
+  f := @AFile;
+  WriteNode(Root);
+end;
 
-{$ENDIF}
+// -------------------------------------------------------------------
+//   Interface implementation
+// -------------------------------------------------------------------
 
 procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
+
 var
   fs: TFileStream;
+  
 begin
-  // write first to memory buffer and then as one whole block to file
-  WriteXMLMemStream(doc);
+  fs := TFileStream.Create(AFileName, fmCreate);
   try
-    fs := TFileStream.Create(AFileName, fmCreate);
-    fs.CopyFrom(Stream,Stream.Size);
-    fs.Free;
+     WriteXMLFile(doc, fs);
   finally
-    Stream.Free;
+    fs.Free;
   end;
 end;
 
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
-{$IFDEF UsesFPCWidestrings}
-var
-  MyWideStringManager,OldWideStringManager: TWideStringManager;
-{$ENDIF}
 begin
-  {$IFDEF UsesFPCWidestrings}
-  GetWideStringManager(MyWideStringManager);
-
-  MyWideStringManager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
-  MyWideStringManager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
-  SetWideStringManager(MyWideStringManager, OldWideStringManager);
+  with TTextXMLWriter.Create do
   try
-  {$ENDIF}
-    f := @AFile;
-    wrt := @Text_Write;
-    wrtln := @Text_WriteLn;
-    RootWriter(doc);
-  {$IFDEF UsesFPCWidestrings}
+    WriteXML(doc, AFile);
   finally
-    SetWideStringManager(OldWideStringManager);
+    Free;
   end;
-  {$ENDIF}
 end;
 
 procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
-{$IFDEF UsesFPCWidestrings}
-var
-  OldWideStringManager: TWideStringManager;
-{$ENDIF}
 begin
-  {$IFDEF UsesFPCWidestrings}
-  SetWideStringManager(WideStringManager, OldWideStringManager);
+  with TStreamXMLWriter.Create do
   try
-  {$ENDIF}
-    Stream := AStream;
-    wrt := @Stream_Write;
-    wrtln := @Stream_WriteLn;
-    RootWriter(doc);
-  {$IFDEF UsesFPCWidestrings}
+    WriteXML(doc, AStream);
   finally
-    SetWideStringManager(OldWideStringManager);
+    Free;
   end;
-  {$ENDIF}
 end;
 
-
 procedure WriteXML(Element: TDOMNode; const AFileName: String);
-{$IFDEF UsesFPCWidestrings}
-var
-  OldWideStringManager: TWideStringManager;
-{$ENDIF}
 begin
-  {$IFDEF UsesFPCWidestrings}
-  SetWideStringManager(WideStringManager, OldWideStringManager);
-  try
-  {$ENDIF}
-    Stream := TFileStream.Create(AFileName, fmCreate);
-    wrt := @Stream_Write;
-    wrtln := @Stream_WriteLn;
-    InitWriter;
-    WriteNode(Element);
-    Stream.Free;
-  {$IFDEF UsesFPCWidestrings}
-  finally
-    SetWideStringManager(OldWideStringManager);
-  end;
-  {$ENDIF}
+  WriteXML(TXMLDocument(Element), AFileName);
 end;
 
 procedure WriteXML(Element: TDOMNode; var AFile: Text);
-{$IFDEF UsesFPCWidestrings}
-var
-  OldWideStringManager: TWideStringManager;
-{$ENDIF}
 begin
-  {$IFDEF UsesFPCWidestrings}
-  SetWideStringManager(WideStringManager, OldWideStringManager);
-  try
-  {$ENDIF}
-    f := @AFile;
-    wrt := @Text_Write;
-    wrtln := @Text_WriteLn;
-    InitWriter;
-    WriteNode(Element);
-  {$IFDEF UsesFPCWidestrings}
-  finally
-    SetWideStringManager(OldWideStringManager);
-  end;
-  {$ENDIF}
+  WriteXML(TXMLDocument(Element), AFile);
 end;
 
 procedure WriteXML(Element: TDOMNode; AStream: TStream);
-{$IFDEF UsesFPCWidestrings}
-var
-  OldWideStringManager: TWideStringManager;
-{$ENDIF}
 begin
-  {$IFDEF UsesFPCWidestrings}
-  SetWideStringManager(WideStringManager, OldWideStringManager);
-  try
-  {$ENDIF}
-    stream := AStream;
-    wrt := @Stream_Write;
-    wrtln := @Stream_WriteLn;
-    InitWriter;
-    WriteNode(Element);
-  {$IFDEF UsesFPCWidestrings}
-  finally
-    SetWideStringManager(OldWideStringManager);
-  end;
-  {$ENDIF}
+  WriteXML(TXMLDocument(Element), AStream);
 end;
 
+
+
 end.

fcl/xml/xpath.pp

@@ -1223,7 +1223,7 @@ begin
   inherited Destroy;
 end;
 
-function TXPathNodeSetVariable.TypeName: String;
+class function TXPathNodeSetVariable.TypeName: String;
 begin
   Result := SNodeSet;
 end;
@@ -1248,7 +1248,7 @@ begin
   FValue := AValue;
 end;
 
-function TXPathBooleanVariable.TypeName: String;
+class function TXPathBooleanVariable.TypeName: String;
 begin
   Result := SBoolean;
 end;
@@ -1281,7 +1281,7 @@ begin
   FValue := AValue;
 end;
 
-function TXPathNumberVariable.TypeName: String;
+class function TXPathNumberVariable.TypeName: String;
 begin
   Result := SNumber;
 end;
@@ -1312,7 +1312,7 @@ begin
   FValue := AValue;
 end;
 
-function TXPathStringVariable.TypeName: String;
+class function TXPathStringVariable.TypeName: String;
 begin
   Result := SString;
 end;

utils/fpdoc/dw_html.pp

@@ -102,7 +102,7 @@ type
     CurOutputNode: TDOMNode;
     InsideHeadRow, DoPasHighlighting: Boolean;
     HighlighterFlags: Byte;
-    
+
     FooterFile: string;
 
     function ResolveLinkID(const Name: String): DOMString;
@@ -2282,11 +2282,11 @@ begin
   AppendText(CodeEl, AType.Name);
   AppendSym(CodeEl, ' = ');
 
-  If Assigned(DocNode) and 
-     Assigned(DocNode.Node) and 
+  If Assigned(DocNode) and
+     Assigned(DocNode.Node) and
      (Docnode.Node['opaque']='1') then
     AppendText(CodeEl,SDocOpaque)
-  else 
+  else
     begin
     // Alias
     if AType.ClassType = TPasAliasType then
@@ -2967,7 +2967,7 @@ begin
    WriteHTMLPages;
 end;
 
-procedure THTMLWriter.Usage(List: TStrings);
+class procedure THTMLWriter.Usage(List: TStrings);
 begin
   List.add('--footer');
   List.Add(SHTMLUsageFooter);

utils/fpdoc/dw_latex.pp

@@ -624,7 +624,7 @@ begin
   WriteLnF('\pageref{%s} & %s  & %s \\',[ALabel,AName,ADescr]);
 end;
 
-function TLaTeXWriter.FileNameExtension: String;
+class function TLaTeXWriter.FileNameExtension: String;
 begin
   Result:=TexExtension;
 end;

utils/fpdoc/dw_man.pp

@@ -1740,14 +1740,12 @@ begin
 end;
 
 
-function TManWriter.FileNameExtension: String;
+class function TManWriter.FileNameExtension: String;
 begin
   Result:=IntToStr(DefaultManSection);
 end;
 
 
-
-
 procedure TManWriter.WriteClassMethodOverview(ClassDecl: TPasClassType);
 
 var

utils/fpdoc/dw_txt.pp

@@ -498,7 +498,7 @@ begin
   LineWidth:=DefaultLineWidth;
 end;
 
-procedure TTXTWriter.Usage(List: TStrings);
+class procedure TTXTWriter.Usage(List: TStrings);
 begin
   inherited Usage(List);
 end;
@@ -649,7 +649,7 @@ begin
   WriteLnF('%.30s %s ',[AName,ADescr]);
 end;
 
-function TTxtWriter.FileNameExtension: String;
+class function TTxtWriter.FileNameExtension: String;
 begin
   Result:=TxtExtension;
 end;