--- Merging r32093 into '.':

U    packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r32093 into '.':
 U   .
--- Merging r32131 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
U    packages/fcl-db/src/base/bufdataset.pas
U    packages/fcl-db/src/sdf/sdfdata.pp
U    packages/fcl-db/src/memds/memds.pp
--- Recording mergeinfo for merge of r32131 into '.':
 G   .
--- Merging r32359 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32359 into '.':
 G   .
--- Merging r32558 into '.':
U    packages/fcl-db/src/base/bufdataset_parser.pp
--- Recording mergeinfo for merge of r32558 into '.':
 G   .
--- Merging r32566 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32566 into '.':
 G   .
--- Merging r32729 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Recording mergeinfo for merge of r32729 into '.':
 G   .
--- Merging r32753 into '.':
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32753 into '.':
 G   .
--- Merging r32754 into '.':
G    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32754 into '.':
 G   .
--- Merging r32755 into '.':
G    packages/fcl-db/src/sqlite/sqliteds.pas
--- Recording mergeinfo for merge of r32755 into '.':
 G   .
--- Merging r32796 into '.':
U    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r32796 into '.':
 G   .
--- Merging r32800 into '.':
U    packages/fcl-db/src/base/sqlscript.pp
--- Recording mergeinfo for merge of r32800 into '.':
 G   .
--- Merging r32801 into '.':
U    packages/fcl-db/tests/dbtestframework.pas
U    packages/fcl-db/tests/testsqlscript.pas
--- Recording mergeinfo for merge of r32801 into '.':
 G   .
--- Merging r32807 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r32807 into '.':
 G   .
--- Merging r32808 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r32808 into '.':
 G   .
--- Merging r32810 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32810 into '.':
 G   .

# revisions: 32093,32131,32359,32558,32566,32729,32753,32754,32755,32796,32800,32801,32807,32808,32810

git-svn-id: branches/fixes_3_0@33368 -

packages/fcl-db/src/base/bufdataset.pas

@@ -158,7 +158,8 @@ type
     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
     procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
     function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
-    function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
+    function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual;
+    function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline;
 
     procedure InitialiseIndex; virtual; abstract;
 
@@ -226,7 +227,7 @@ type
     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
     procedure GotoBookmark(const ABookmark : PBufBookmark); override;
-
+    function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override;
     procedure InitialiseIndex; override;
 
     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
@@ -1248,15 +1249,17 @@ begin
   if Fields.Count = 0 then
     DatabaseError(SErrNoDataset);
 
-  // If there is a field with FieldNo=0 then the fields are not found to the
-  // FieldDefs which is a sign that there is no dataset created. (Calculated and
-  // lookup fields have FieldNo=-1)
+  // search for autoinc field
   FAutoIncField:=nil;
-  for i := 0 to Fields.Count-1 do
-    if Fields[i].FieldNo=0 then
-      DatabaseError(SErrNoDataset)
-    else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then
-      FAutoIncField := TAutoIncField(Fields[i]);
+  if FAutoIncValue>-1 then
+  begin
+    for i := 0 to Fields.Count-1 do
+      if Fields[i] is TAutoIncField then
+      begin
+        FAutoIncField := TAutoIncField(Fields[i]);
+        Break;
+      end;
+  end;
 
   InitDefaultIndexes;
   CalcRecordSize;
@@ -1367,12 +1370,14 @@ begin
   Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
 end;
 
-function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
+function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer;
 begin
-  if assigned(ABookmark1) and assigned(ABookmark2) then
-    Result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData)
-  else
-    Result := False;
+  Result := 0;
+end;
+
+function TBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
+begin
+  Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (CompareBookmarks(ABookmark1, ABookmark2) = 0);
 end;
 
 function TBufIndex.GetRecord(ABookmark: PBufBookmark; GetMode: TGetMode): TGetResult;
@@ -1537,6 +1542,35 @@ begin
   FCurrentRecBuf := ABookmark^.BookmarkData;
 end;
 
+function TDoubleLinkedBufIndex.CompareBookmarks(const ABookmark1,ABookmark2: PBufBookmark): integer;
+var ARecord1, ARecord2 : PBufRecLinkItem;
+begin
+  // valid bookmarks expected
+  // estimate result using memory addresses of records
+  Result := ABookmark1^.BookmarkData - ABookmark2^.BookmarkData;
+  if Result = 0 then
+    Exit
+  else if Result < 0 then
+  begin
+    Result   := -1;
+    ARecord1 := ABookmark1^.BookmarkData;
+    ARecord2 := ABookmark2^.BookmarkData;
+  end
+  else
+  begin
+    Result   := +1;
+    ARecord1 := ABookmark2^.BookmarkData;
+    ARecord2 := ABookmark1^.BookmarkData;
+  end;
+  // if we need relative position of records with given bookmarks we must
+  // traverse through index until we reach lower bookmark or 1st record
+  while assigned(ARecord2) and (ARecord2 <> ARecord1) and (ARecord2 <> FFirstRecBuf) do
+    ARecord2 := ARecord2[IndNr].prior;
+  // if we found lower bookmark as first, then estimated position is correct
+  if ARecord1 <> ARecord2 then
+    Result := -Result;
+end;
+
 procedure TDoubleLinkedBufIndex.InitialiseIndex;
 begin
   // Do nothing
@@ -1564,7 +1598,7 @@ begin
   FFirstRecBuf:= nil;
 end;
 
-function TDoubleLinkedBufIndex.GetRecNo: integer;
+function TDoubleLinkedBufIndex.GetRecNo: Longint;
 var ARecord : PBufRecLinkItem;
 begin
   ARecord := FCurrentRecBuf;
@@ -2050,8 +2084,8 @@ begin
     StartBuf := 0;
   Result := False;
   for x := StartBuf to high(FUpdateBuffer) do
-   if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
-      (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
+   if FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
+      (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
     begin
     FCurrentUpdateBuffer := x;
     Result := True;
@@ -2064,10 +2098,10 @@ function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBook
 begin
   // if the current update buffer matches, immediately return true
   if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
-      FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
+      FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
       (IncludePrior
         and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete)
-        and  FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
+        and  FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
      begin
      Result := True;
      end
@@ -2290,7 +2324,7 @@ var StoreRecBM     : TBufBookmark;
 
           {for x := length(FUpdateBuffer)-1 downto 0 do
             begin
-            if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
+            if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
               CancelUpdBuffer(FUpdateBuffer[x]);
             end;}
           FreeRecordBuffer(OldValuesBuffer);
@@ -2314,7 +2348,7 @@ var StoreRecBM     : TBufBookmark;
         FCurrentIndex.GotoBookmark(@Bm);
         TmpBuf:=FCurrentIndex.CurrentRecord;
         // resync won't work if the currentbuffer is freed...
-        if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
+        if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
           begin
           GotoBookmark(@StoreRecBM);
           if ScrollForward = grEOF then
@@ -2880,7 +2914,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
       if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
         begin
         repeat
-          if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
+          if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
             StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
         until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
         end;
@@ -3051,13 +3085,16 @@ begin
   Result:=assigned(FCurrentIndex) and  FCurrentIndex.BookmarkValid(pointer(ABookmark));
 end;
 
-function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
-  ): Longint;
+function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
 begin
-  if not assigned(Bookmark1) or not assigned(Bookmark2) then
-    Result := 0
-  else if Assigned(FCurrentIndex) and FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) then
+  if Bookmark1 = Bookmark2 then
     Result := 0
+  else if not assigned(Bookmark1) then
+    Result := 1
+  else if not assigned(Bookmark2) then
+    Result := -1
+  else if assigned(FCurrentIndex) then
+    Result := FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2))
   else
     Result := -1;
 end;
@@ -3148,7 +3185,7 @@ begin
       FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
 
       for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
-        if Findexes[0].CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
+        if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
           FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
 
       AddRecordBuffer:=False;

packages/fcl-db/src/base/bufdataset_parser.pp

@@ -143,6 +143,12 @@ type
     procedure Refresh(Buffer: TRecordBuffer); override;
   end;
 
+  TBCDFieldVar = class(TFloatFieldVar)
+  public
+    procedure Refresh(Buffer: TRecordBuffer); override;
+  end;
+
+
 //--TFieldVar----------------------------------------------------------------
 constructor TFieldVar.Create(UseField: TField);
 begin
@@ -273,6 +279,16 @@ begin
     FFieldVal := False;
 end;
 
+procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer);
+var c: currency;
+begin
+  if FField.DataSet.GetFieldData(FField,@c) then
+    FFieldVal := c
+  else
+    FFieldVal := 0;
+end;
+
+
 //--TBufDatasetParser---------------------------------------------------------------
 
 constructor TBufDatasetParser.Create(Adataset: TDataSet);
@@ -387,7 +403,7 @@ begin
         TempFieldVar := TFloatFieldVar.Create(FieldInfo);
         TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
       end;
-    ftAutoInc, ftInteger, ftSmallInt:
+    ftAutoInc, ftInteger, ftSmallInt, ftWord:
       begin
         TempFieldVar := TIntegerFieldVar.Create(FieldInfo);
         TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
@@ -402,6 +418,11 @@ begin
         TempFieldVar := TDateTimeFieldVar.Create(FieldInfo);
         TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
       end;
+    ftBCD:
+      begin
+        TempFieldVar := TBCDFieldVar.Create(FieldInfo);
+        TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
+      end;
   else
     raise EDatabaseError.CreateFmt(SErrIndexBasedOnInvField, [VarName,Fieldtypenames[FieldInfo.DataType]]);
   end;

packages/fcl-db/src/base/dataset.inc

@@ -105,7 +105,9 @@ begin
         begin
         FFieldDef := nil;
         FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
-        if FieldIndex <> -1 then
+        if FieldIndex = -1 then
+          DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self)
+        else
           begin
           FFieldDef := FieldDefs[FieldIndex];
           FFieldNo := FFieldDef.FieldNo;

packages/fcl-db/src/base/sqlscript.pp

@@ -278,7 +278,11 @@ function TCustomSQLScript.Available: Boolean;
 
 begin
   With FSQL do
-    Result:=(FLine<Count) or (FCol<Length(Strings[Count-1]))
+    Result:=(FLine<Count) or
+            (
+              ( FLine = Count ) and
+              ( FCol < Length(Strings[Count-1] ) )
+            );
 end;
 
 procedure TCustomSQLScript.InternalStatement(Statement: TStrings;  var StopExecution: Boolean);
@@ -442,12 +446,11 @@ function TCustomSQLScript.NextStatement: AnsiString;
 
 var
   pnt: AnsiString;
-  addnewline,terminator_found: Boolean;
+  terminator_found: Boolean;
 
 begin
   terminator_found:=False;
   ClearStatement;
-  addnewline:=false;
   while FLine <= FSQL.Count do
     begin
     pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
@@ -477,12 +480,9 @@ begin
       begin
       FComment:=True;
       if FCommentsInSQL then
-        begin
         AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
-        AddNewLine:=true;
-        end;
       Inc(Fline);
-      FCol:=0;
+      FCol:=1;
       FComment:=False;
       end
     else if pnt = '"' then
@@ -498,8 +498,7 @@ begin
       AddToStatement(pnt,False);
       FCol:=FCol + length(pnt);
       pnt:=FindNextSeparator(['''']);
-      AddToStatement(pnt,addnewline);
-      addnewline:=False;
+      AddToStatement(pnt,false);
       FCol:=FCol + length(pnt);
       end;
     end;

packages/fcl-db/src/memds/memds.pp

@@ -132,6 +132,7 @@ type
     constructor Create(AOwner:TComponent); override;
     destructor Destroy; override;
     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
+    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override;
     function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
@@ -418,6 +419,14 @@ begin
   Result := (ReqBookmark>=0) and (ReqBookmark<FRecCount);
 end;
 
+function TMemDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
+const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
+begin
+  Result := r[Bookmark1=nil, Bookmark2=nil];
+  if Result = 2 then
+    Result := PInteger(Bookmark1)^ - PInteger(Bookmark2)^;
+end;
+
 function TMemDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode
   ): TStream;
 begin

packages/fcl-db/src/sdf/sdfdata.pp

@@ -209,8 +209,8 @@ type
     procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
     procedure ClearCalcFields(Buffer: TRecordBuffer); override;
-    function GetRecordCount: Integer; override;
-    function GetRecNo: Integer; override;
+    function GetRecordCount: Longint; override;
+    function GetRecNo: Longint; override;
     procedure SetRecNo(Value: Integer); override;
     function GetCanModify: boolean; override;
     function RecordFilter(RecBuf: TRecordBuffer): Boolean;
@@ -222,6 +222,7 @@ type
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
     function  BookmarkValid(ABookmark: TBookmark): Boolean; override;
+    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
     function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     procedure RemoveBlankRecords; dynamic;
     procedure RemoveExtraColumns; dynamic;
@@ -780,6 +781,14 @@ begin
   Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1);
 end;
 
+function TFixedFormatDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
+const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
+begin
+  Result := r[Bookmark1=nil, Bookmark2=nil];
+  if Result = 2 then
+    Result := PPtrInt(Bookmark1)^ - PPtrInt(Bookmark2)^;
+end;
+
 procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
 var
   Index: Integer;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -106,6 +106,7 @@ Type
 
   TConnectionName = class (TSQLConnection)
   private
+    FSkipLibrarVersionCheck : Boolean;
     FHostInfo: String;
     FServerInfo: String;
     FMySQL : PMySQL;
@@ -164,6 +165,7 @@ Type
     property ClientInfo: string read GetClientInfo;
     property ServerStatus : String read GetServerStatus;
   published
+    Property SkipLibrarVersionCheck : Boolean Read FSkipLibrarVersionCheck Write FSkipLibrarVersionCheck;
     property DatabaseName;
     property HostName;
     property KeepConnection;
@@ -495,13 +497,16 @@ var
   FullVersion: string;
 begin
   InitialiseMysql;
-  FullVersion:=strpas(mysql_get_client_info());
-  // Version string should start with version number:
-  // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
-  // version only.
-  if (pos(MySQLVersion, FullVersion) <> 1) and
-     (pos(MariaDBVersion, FullVersion) <> 1) then
-    Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
+  if not SkipLibrarVersionCheck then
+    begin
+    FullVersion:=strpas(mysql_get_client_info());
+    // Version string should start with version number:
+    // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
+    // version only.
+    if (pos(MySQLVersion, FullVersion) <> 1) and
+       (pos(MariaDBVersion, FullVersion) <> 1) then
+      Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
+    end;  
   inherited DoInternalConnect;
   ConnectToServer;
   SelectDatabase;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -1006,9 +1006,9 @@ begin
           begin
           case AParams[i].DataType of
             ftDateTime:
-              s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', AParams[i].AsDateTime);
+              s := FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss.zzz', AParams[i].AsDateTime);
             ftDate:
-              s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime);
+              s := FormatDateTime('yyyy"-"mm"-"dd', AParams[i].AsDateTime);
             ftTime:
               s := FormatTimeInterval(AParams[i].AsDateTime);
             ftFloat, ftBCD:

packages/fcl-db/src/sqldb/sqldb.pp

@@ -25,6 +25,13 @@ uses SysUtils, Classes, DB, bufdataset, sqlscript;
 type
   TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
 
+const
+  TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name',
+      '???', 'procedure_name', 'column_name', 'param_name',
+      'index_name', 'package_name', 'schema_name','sequence');
+
+type
+
   TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
     stDDL, stGetSegment, stPutSegment, stExecProcedure,
     stStartTrans, stCommit, stRollback, stSelectForUpd);
@@ -135,6 +142,33 @@ type
     procedure Update; override;
   end;
 
+
+  TSqlObjectIdentifierList = class;
+
+  { TSqlObjectIdenfier }
+
+  TSqlObjectIdenfier = class(TCollectionItem)
+  private
+    FObjectName: String;
+    FSchemaName: String;
+  public
+    constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = '');
+    property SchemaName: String read FSchemaName write FSchemaName;
+    property ObjectName: String read FObjectName write FObjectName;
+  end;
+
+  { TSqlObjectIdentifierList }
+
+  TSqlObjectIdentifierList = class(TCollection)
+  private
+    function GetIdentifier(Index: integer): TSqlObjectIdenfier;
+    procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
+  public
+    function AddIdentifier: TSqlObjectIdenfier; overload;
+    function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload;
+    property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default;
+  end;
+
 type
 
   { TSQLConnection }
@@ -221,6 +255,7 @@ type
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
 
+    function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
     Procedure MaybeConnect;
 
     Property Statements : TFPList Read FStatements;
@@ -784,6 +819,31 @@ begin
 end;
 
 
+{ TSqlObjectIdentifierList }
+
+function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier;
+begin
+  Result := Items[Index] as TSqlObjectIdenfier;
+end;
+
+procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
+begin
+  Items[Index] := AValue;
+end;
+
+function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier;
+begin
+  Result:=Add as TSqlObjectIdenfier;
+end;
+
+function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String;
+  Const ASchemaName: String = ''): TSqlObjectIdenfier;
+begin
+  Result:=AddIdentifier();
+  Result.SchemaName:=ASchemaName;
+  Result.ObjectName:=AObjectName;
+end;
+
 { TSQLDBFieldDefs }
 
 class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
@@ -1228,11 +1288,11 @@ begin
   if not ATransaction.Active then
     ATransaction.MaybeStartTransaction;
 
-  try
-    SQL := TrimRight(SQL);
-    if SQL = '' then
-      DatabaseError(SErrNoStatement);
+  SQL := TrimRight(SQL);
+  if SQL = '' then
+    DatabaseError(SErrNoStatement);
 
+  try
     Cursor := AllocateCursorHandle;
     Cursor.FStatementType := stUnknown;
     If LogEvent(detPrepare) then
@@ -1354,6 +1414,43 @@ begin
   GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
 end;
 
+Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer; 
+var
+  qry : TCustomSQLQuery;
+  vSchemaName, vObjectName: String;
+  f: TField;
+begin
+  Result:=0;
+  if not assigned(Transaction) then
+    DatabaseError(SErrConnTransactionnSet);
+
+  qry := TCustomSQLQuery.Create(nil);
+  try
+    qry.transaction := Transaction;
+    qry.database := Self;
+    with qry do
+      begin
+      ParseSQL := False;
+      SetSchemaInfo(ASchemaType,TSchemaObjectNames[ASchemaType],'');
+      open;
+      f:=FindField(TSchemaObjectNames[stSchemata]);
+      while not eof do
+        begin
+        vSchemaName:='';
+        if Assigned(f) then
+           vSchemaName:=f.AsString;
+        vObjectName:=FieldByName(FSchemaObjectName).AsString;
+        AList.AddIdentifier(vObjectName, vSchemaName);
+        Next;
+        Inc(Result);
+        end;
+      end;
+  finally
+    qry.free;
+  end;
+
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -3270,6 +3367,7 @@ begin
     If Assigned(FProxy) then
       FreeProxy;
     FConnectorType:=AValue;
+    CreateProxy;
     end;
 end;
 
@@ -3287,7 +3385,7 @@ Var
 
 begin
   inherited DoInternalConnect;
-  CreateProxy;
+  CheckProxy;
   FProxy.CharSet:=Self.CharSet;
   FProxy.DatabaseName:=Self.DatabaseName;
   FProxy.HostName:=Self.HostName;
@@ -3327,6 +3425,7 @@ begin
     DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self);
   FProxy:=D.ConnectionClass.Create(Self);
   FFieldNameQuoteChars := FProxy.FieldNameQuoteChars;
+  FConnOptions := FProxy.ConnOptions;
 end;
 
 procedure TSQLConnector.FreeProxy;
@@ -3548,6 +3647,16 @@ begin
     end;
 end;
 
+{ TSqlObjectIdenfier }
+
+constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList;
+  const AObjectName: String; Const ASchemaName: String = '');
+begin
+  inherited Create(ACollection);
+  FSchemaName:=ASchemaName;
+  FObjectName:=AObjectName;
+end;
+
 Initialization
 
 Finalization

packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -109,6 +109,7 @@ type
     {$endif}
     FInternalActiveBuffer: PDataRecord;
     FInsertBookmark: PDataRecord;
+    FFilterBuffer: TRecordBuffer;
     FOnCallback: TSqliteCallback;
     FMasterLink: TMasterDataLink;
     FIndexFieldNames: String;
@@ -176,6 +177,7 @@ type
     procedure DoBeforeClose; override;
     procedure DoAfterInsert; override;
     procedure DoBeforeInsert; override;
+    procedure DoFilterRecord(var Acceptable: Boolean); virtual;
     procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
     procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
     function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
@@ -578,6 +580,13 @@ begin
   inherited DoBeforeInsert;
 end;
 
+procedure TCustomSqliteDataset.DoFilterRecord(var Acceptable: Boolean);
+begin
+  Acceptable := True;
+  if Assigned(OnFilterRecord) then
+    OnFilterRecord(Self, Acceptable);
+end;
+
 destructor TCustomSqliteDataset.Destroy;
 begin
   inherited Destroy;
@@ -746,10 +755,14 @@ begin
   else
     FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
 
-  if not (State in [dsCalcFields, dsInternalCalc]) then
-    FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset]
-  else
-    FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
+  case State of
+    dsCalcFields, dsInternalCalc:
+      FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
+    dsFilter:
+      FieldRow := PPDataRecord(FFilterBuffer)^^.Row[FieldOffset];
+    else
+      FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset];
+  end;
 
   Result := FieldRow <> nil;  
   if Result and (Buffer <> nil) then //supports GetIsNull
@@ -789,31 +802,46 @@ begin
 end;
 
 function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
+var
+  Acceptable: Boolean;
+  SaveState: TDataSetState;
 begin
   Result := grOk;
-  case GetMode of
-    gmPrior:
-      if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
-        Result := grBOF
-      else
-        FCurrentItem:=FCurrentItem^.Previous;
-    gmCurrent:
-      if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
-         Result := grError;
-    gmNext:
-      if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
-        Result := grEOF
-      else
-        FCurrentItem := FCurrentItem^.Next;
-  end; //case
-  if Result = grOk then
-  begin
-    PDataRecord(Pointer(Buffer)^) := FCurrentItem;
-    FCurrentItem^.BookmarkFlag := bfCurrent;
-    GetCalcFields(Buffer);
-  end
-    else if (Result = grError) and DoCheck then
-      DatabaseError('No records found', Self);
+  repeat
+    Acceptable := True;
+    case GetMode of
+      gmPrior:
+        if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
+          Result := grBOF
+        else
+          FCurrentItem:=FCurrentItem^.Previous;
+      gmCurrent:
+        if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
+           Result := grError;
+      gmNext:
+        if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
+          Result := grEOF
+        else
+          FCurrentItem := FCurrentItem^.Next;
+    end; //case
+    if Result = grOk then
+    begin
+      PDataRecord(Pointer(Buffer)^) := FCurrentItem;
+      FCurrentItem^.BookmarkFlag := bfCurrent;
+      GetCalcFields(Buffer);
+      if Filtered then
+      begin
+        FFilterBuffer := Buffer;
+        SaveState := SetTempState(dsFilter);
+        DoFilterRecord(Acceptable);
+        if (GetMode = gmCurrent) and not Acceptable then
+          Result := grError;
+        RestoreState(SaveState);
+      end;
+    end
+      else if (Result = grError) and DoCheck then
+        DatabaseError('No records found', Self);
+  until (Result <> grOK) or Acceptable;
 end;
 
 function TCustomSqliteDataset.GetRecordCount: Integer;
@@ -1573,7 +1601,7 @@ begin
   FMasterLink.DataSource := Value;
 end;
 
-procedure TCustomSqliteDataset.ExecSQL(const ASQL: String);
+procedure TCustomSqliteDataset.ExecSQL(const ASql: String);
 begin
   if FSqliteHandle = nil then
     GetSqliteHandle;
@@ -1831,7 +1859,8 @@ begin
     Result := False;
 end;
 
-procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil);
+procedure TCustomSqliteDataset.ExecCallback(const ASql: String;
+  UserData: Pointer);
 var
   CallbackInfo: TCallbackInfo;
 begin
@@ -1913,12 +1942,13 @@ begin
     (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
 end;
 
-function TCustomSqliteDataset.QuickQuery(const ASQL: String): String;
+function TCustomSqliteDataset.QuickQuery(const ASql: String): String;
 begin
   Result := QuickQuery(ASQL, nil, False);
 end;
 
-function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String;
+function TCustomSqliteDataset.QuickQuery(const ASql: String;
+  const AStrList: TStrings): String;
 begin
   Result := QuickQuery(ASQL, AStrList, False)
 end;  

packages/fcl-db/src/sqlite/sqlite3ds.pas

@@ -227,17 +227,17 @@ begin
         SQLITE_FLOAT:
           AType := ftFloat;
       else
-	    begin
+        begin
           AType := ftString;
-		  DataSize := DefaultStringSize;
-		end;  		
+          DataSize := DefaultStringSize;
+        end;
       end;
     end else
     begin
       AType := ftString;
-	  DataSize := DefaultStringSize;
+      DataSize := DefaultStringSize;
     end;
-    FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, DataSize);
+    FieldDefs.Add(FieldDefs.MakeNameUnique(String(sqlite3_column_name(vm, i))), AType, DataSize);
     //Set the pchar2sql function
     case AType of
       ftString:

packages/fcl-db/src/sqlite/sqliteds.pas

@@ -184,12 +184,16 @@ begin
     begin
       AType := ftString;
     end;
-    FieldDefs.Add(String(ColumnNames[i]), AType, DataSize);
+    FieldDefs.Add(FieldDefs.MakeNameUnique(String(ColumnNames[i])), AType, DataSize);
     //Set the pchar2sql function
-    if AType in [ftString, ftMemo] then
-      FGetSqlStr[i] := @Char2SQLStr
+    case AType of
+      ftString:
+        FGetSqlStr[i] := @Char2SQLStr;
+      ftMemo:
+        FGetSqlStr[i] := @Memo2SQLStr;
     else
       FGetSqlStr[i] := @Num2SQLStr;
+    end;
   end;
   sqlite_finalize(vm, nil);
   {

packages/fcl-db/tests/dbtestframework.pas

@@ -28,7 +28,9 @@ uses
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTMemDataset,
-  TestDBExport, tccsvdataset,
+  TestDBExport, 
+  tccsvdataset,
+  testsqlscript,
   consoletestrunner;
 
 Procedure LegacyOutput;

packages/fcl-db/tests/testdbbasics.pas

@@ -8,7 +8,7 @@ interface
 
 uses
 {$IFDEF FPC}
-  fpcunit, testregistry,
+  testregistry,
 {$ELSE FPC}
   TestFramework,
 {$ENDIF FPC}
@@ -58,6 +58,7 @@ type
     procedure TestAssignFieldftFixedChar;
     procedure TestSelectQueryBasics;
     procedure TestPostOnlyInEditState;
+    procedure TestCancel;
     procedure TestMove;                    // bug 5048
     procedure TestActiveBufferWhenClosed;
     procedure TestEOFBOFClosedDataset;
@@ -138,6 +139,7 @@ type
 
     procedure TestBookmarks;
     procedure TestBookmarkValid;
+    procedure TestCompareBookmarks;
 
     procedure TestDelete1;
     procedure TestDelete2;
@@ -274,6 +276,18 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestCancel;
+begin
+  with DBConnector.GetNDataset(1) do
+  begin
+    Open;
+    Edit;
+    FieldByName('name').AsString := 'EditName1';
+    Cancel;
+    CheckEquals('TestName1', FieldByName('name').AsString, 'Cancel did not restored previous value');
+  end;
+end;
+
 procedure TTestDBBasics.TestMove;
 var i,count      : integer;
     aDatasource  : TDataSource;
@@ -802,7 +816,7 @@ begin
 end;
 
 procedure TTestCursorDBBasics.TestBookmarkValid;
-var BM1,BM2,BM3,BM4,BM5 : TBookmark;
+var BM1,BM2,BM3,BM4,BM5,BM6 : TBookmark;
 begin
   with DBConnector.GetNDataset(true,14) do
     begin
@@ -834,9 +848,39 @@ begin
     CheckTrue(BookmarkValid(BM3));
     CheckTrue(BookmarkValid(BM2));
     CheckTrue(BookmarkValid(BM1));
+    Append;
+    BM6 := GetBookmark;
+    CheckFalse(BookmarkValid(BM6));
     end;
 end;
 
+procedure TTestCursorDBBasics.TestCompareBookmarks;
+var
+  FirstBookmark, LastBookmark, EditBookmark, PostEditBookmark: TBookmark;
+begin
+  with DBConnector.GetNDataset(true,14) do
+  begin
+    Open;
+    FirstBookmark := GetBookmark;
+
+    Edit;
+    EditBookmark := GetBookmark;
+    Post;
+    PostEditBookmark := GetBookmark;
+
+    Last;
+    LastBookmark := GetBookmark;
+
+    CheckEquals(0, CompareBookmarks(FirstBookmark, EditBookmark));
+    CheckEquals(0, CompareBookmarks(EditBookmark, PostEditBookmark));
+    CheckTrue(CompareBookmarks(FirstBookmark, LastBookmark) < 0, 'b1<b2');
+    CheckTrue(CompareBookmarks(LastBookmark, FirstBookmark) > 0, 'b1>b2');
+    CheckEquals(0, CompareBookmarks(nil, nil), '(nil,nil)');
+    CheckEquals(-1, CompareBookmarks(FirstBookmark, nil), '(b1,nil)');
+    CheckEquals(+1, CompareBookmarks(nil, FirstBookmark), '(nil,b2)');
+  end;
+end;
+
 procedure TTestCursorDBBasics.TestLocate;
 begin
   with DBConnector.GetNDataset(true,13) do

packages/fcl-db/tests/testsqlscript.pas

@@ -12,7 +12,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit testcsqlscript;
+unit testsqlscript;
 
 {$mode objfpc}{$H+}
 
@@ -34,7 +34,7 @@ type
   protected
     procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
     procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
-    procedure ExecuteCommit; override;
+    procedure ExecuteCommit(CommitRetaining: boolean=true); override;
     procedure DefaultDirectives; override;
   public
     constructor create (AnOwner: TComponent); override;
@@ -98,6 +98,7 @@ type
     procedure TestCommentInComment;
     procedure TestCommentInQuotes1;
     procedure TestCommentInQuotes2;
+    Procedure TestDashDashComment;
     procedure TestQuote1InComment;
     procedure TestQuote2InComment;
     procedure TestQuoteInQuotes1;
@@ -174,7 +175,7 @@ begin
     raise exception.create(DoException);
 end;
 
-procedure TMyScript.ExecuteCommit;
+procedure TMyScript.ExecuteCommit(CommitRetaining: boolean=true);
 begin
   inc (FCommits);
   if DoException <> '' then
@@ -270,7 +271,20 @@ begin
     AssertFalse ('Aborted', Aborted);
     AssertEquals ('Line', 0, Line);
     AssertEquals ('Defines', 0, Defines.count);
-    AssertEquals ('Directives', 10, Directives.count);
+    AssertEquals ('Directives', 12, Directives.count);
+    AssertTrue('Have SET TERM',Directives.IndexOf('SET TERM')<>-1);
+    AssertTrue('Have COMMIT WORK',Directives.IndexOf('COMMIT WORK')<>-1);
+    AssertTrue('Have COMMIT RETAIN',Directives.IndexOf('COMMIT RETAIN')<>-1);
+    AssertTrue('Have COMMIT',Directives.IndexOf('COMMIT')<>-1);
+    AssertTrue('Have #IFDEF',Directives.IndexOf('#IFDEF')<>-1);
+    AssertTrue('Have #IFNDEF',Directives.IndexOf('#IFNDEF')<>-1);
+    AssertTrue('Have #ELSE',Directives.IndexOf('#ELSE')<>-1);
+    AssertTrue('Have #ENDIF',Directives.IndexOf('#ENDIF')<>-1);
+    AssertTrue('Have #DEFINE',Directives.IndexOf('#DEFINE')<>-1);
+    AssertTrue('Have #UNDEF',Directives.IndexOf('#UNDEF')<>-1);
+    AssertTrue('Have #UNDEFINE',Directives.IndexOf('#UNDEFINE')<>-1);
+    // This is defined in our test class.
+    AssertTrue('Have STOP',Directives.IndexOf('STOP')<>-1);
     end;
 end;
 
@@ -513,6 +527,18 @@ begin
   AssertStatDir('"iets ""/* meer */"""', '');
 end;
 
+procedure TTestSQLScript.TestDashDashComment;
+begin
+  script.CommentsInSQL := false;
+  Add('-- my comment');
+  Add('CREATE TABLE "tPatients" (');
+  Add('  "BloodGroup" character(2),');
+  Add('  CONSTRAINT "ck_tPatients_BloodGroup" CHECK (("BloodGroup" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))),');
+  Add(');');
+  script.execute;
+  AssertStatDir('"CREATE TABLE ""tPatients"" (   ""BloodGroup"" character(2),   CONSTRAINT ""ck_tPatients_BloodGroup"" CHECK ((""BloodGroup"" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))), )"', '');
+end;
+
 procedure TTestSQLScript.TestQuote1InComment;
 begin
   script.CommentsInSQL := false;