瀏覽代碼

--- Merging r25025 into '.':
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r25026 into '.':
G packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r25027 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r25032 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r25035 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r25036 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r25055 into '.':
U packages/fcl-db/tests/testleaks.sh
U packages/fcl-db/src/sqldb/sqldb.pp
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r25056 into '.':
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r25061 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25063 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r25064 into '.':
U packages/fcl-db/tests/testsqldb.pas
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25065 into '.':
G packages/fcl-db/tests/testsqldb.pas
--- Merging r25084 into '.':
U packages/fcl-db/src/export/XMLXSDExportReadme.TXT
--- Merging r25085 into '.':
U packages/fcl-db/src/export/fpdbexport.pp

# revisions: 25025,25026,25027,25032,25035,25036,25055,25056,25061,25063,25064,25065,25084,25085
r25025 | lacak | 2013-07-02 13:20:04 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

fcl-db: mysql: map UNSIGNED SMALLINT to ftWord fields. TestSupportWordFields
r25026 | lacak | 2013-07-02 13:29:15 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

fcl-db: mysql: formatting (remove unused variables)
r25027 | lacak | 2013-07-02 13:38:33 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: mssql: add comments
r25032 | lacak | 2013-07-03 10:24:51 +0200 (Wed, 03 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

fcl-db: odbc: map UNSIGNED SMALLINT to ftWord fields. TestSupportWordFields
r25035 | lacak | 2013-07-04 08:46:45 +0200 (Thu, 04 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: map ftWord fields to TWordField (avoid potential problem with Big Endian systems)
r25036 | lacak | 2013-07-04 10:25:33 +0200 (Thu, 04 Jul 2013) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db:
- for MSSQL map TINYINT to ftWord
- for SQLite map TINYINT to ftSmallint
- TestTinyint
r25055 | michael | 2013-07-07 20:14:11 +0200 (Sun, 07 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/testleaks.sh

* Fixed Master/Detail relation in SQLDB and fixed memory leak
r25056 | michael | 2013-07-07 20:19:23 +0200 (Sun, 07 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Inherited must be called for Internal(Dis)Connect for housekeeping
r25061 | lacak | 2013-07-08 08:55:15 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db: tests: more complex test for rev.25036
r25063 | lacak | 2013-07-08 12:40:27 +0200 (Mon, 08 Jul 2013) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb:
- do not allocate cursor when opening bufdataset from file
- when closing TSQLQuery do not deallocate cursor while can be prepared (fixes "[SETUP] unable to close due to unfinalised statements" bug for SQLite)
- when unpreparing statement take into account that there are also SQLConnections which does not support [un]preparation of statements ... bur for those we must still call UnRegisterStatement (fixes multiple "[TEARDOWN] Access violation" in tests)
r25064 | lacak | 2013-07-08 13:06:56 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/testsqldb.pas

fcl-db: tests: move 1 test
r25065 | lacak | 2013-07-08 13:50:15 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testsqldb.pas

fcl-db: tests: Add test for Master-detail (see rev.25055)
r25084 | reiniero | 2013-07-11 13:02:08 +0200 (Thu, 11 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/XMLXSDExportReadme.TXT

fcl-db: cosmetic fixed for XMLXSD export readme
r25085 | reiniero | 2013-07-11 13:09:05 +0200 (Thu, 11 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/fpdbexport.pp

fcl-db: cosmetic: corrected fpdbexport.pp comments

git-svn-id: branches/fixes_2_6@25459 -

marco 12 年之前
父節點
當前提交
b3f437e25e

+ 4 - 4
packages/fcl-db/src/export/XMLXSDExportReadme.TXT

@@ -1,7 +1,7 @@
 1. fpXMLXSDExport
 =================
 This export module provides export to various forms of XML, selectable by the ExportFormat setting.
-Note that not exporting indexes appears as a limitation in most formats below, but indexes probably will probably need to be changed anyway in an new environment/database.
+Note that not exporting indexes appears as a limitation in most formats below, but indexes will probably need to be changed anyway in an new environment/database.
 
 1.1 AccessCompatible
 ====================
@@ -18,7 +18,7 @@ We cannot replicate this functionality, so we just base64 encode the BLOB, and l
 
 1.2 ADONETCompatible
 ====================
-This format generates XML compatible with the .Net framework (specifically the ADO.NET data access libraries). It should work for versions 2 to 4; version 1/1.1 has not been tested.
+This format generates XML compatible with the .Net framework (specifically the ADO.NET data access libraries). It should work for .Net versions 2 to 4; version 1/1.1 has not been tested.
 In this format you can also specify XSD or no XSD using the CreateXSD setting.
 This output format is fairly generic and could be usable for import in other applications, as well.
 Limitations:
@@ -49,7 +49,7 @@ Limitations:
 
 2. Other settings
 =================
-As the XML formats used above defines how date/time formats, boolean formats etc are used, these general export settings have no effect:
+As the XML formats used above define how date/time formats, boolean formats etc are used, these general export settings have no effect:
 - BooleanFalse
 - BooleanTrue
 - DateFormat
@@ -63,6 +63,6 @@ As the XML formats used above defines how date/time formats, boolean formats etc
 3. License
 ==========
 The fpXMLXSDExport module is freeware, licensed under the MIT license: all use free, but no liability accepted.
-It is also licensed under the FreePascal license, so take your pick, but don't blame me for things that go wrong.
+It is also licensed under the FreePascal modified LGPL license, so take your pick, but don't blame me for things that go wrong.
 
 Reinier Olislagers, 2011

+ 3 - 2
packages/fcl-db/src/export/fpdbexport.pp

@@ -150,7 +150,7 @@ Type
     Procedure DoDataRowStart; virtual;
     // Override if a simple loop is not enough.
     Procedure ExportDataRow; virtual;
-    // Override to write something at row start.
+    // Override to write something at row end.
     Procedure DoDataRowEnd; virtual;
     // Called after row was exported
     Procedure DoProgress(ItemNo : Integer); Virtual;
@@ -221,8 +221,9 @@ Type
     procedure SetFileName(const AValue: String); virtual;
     // Override if some checking needs to be done prior to opening.
     Procedure CheckFileName; virtual;
-    // Use to open/close textfile. Creates a file stream.
+    // Use to open textfile. Creates a file stream.
     Procedure OpenTextFile;
+    // Use to close textfile.
     Procedure CloseTextFile;
     // Access to stream/file
     Property TextFile : Text Read FTextFile;

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

@@ -356,6 +356,7 @@ end;
 
 procedure TIBConnection.DoInternalDisconnect;
 begin
+  Inherited;
   FDialect := INVALID_DATA;
   if not Connected then
   begin

+ 19 - 4
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -27,11 +27,12 @@
 
     TMSSQLConnection properties:
       HostName - can be specified also as 'servername:port' or 'servername\instance'
+                 (SQL Server Browser Service must be running on server to connect to specific instance)
       CharSet - if you use Microsoft DB-Lib and set to 'UTF-8' then char/varchar fields will be UTF8Encoded/Decoded
                 if you use FreeTDS DB-Lib then you must compile with iconv support (requires libiconv2.dll) or cast char/varchar to nchar/nvarchar in SELECTs
       Params - "AutoCommit=true" - if you don't want explicitly commit/rollback transactions
                "TextSize=16777216" - set maximum size of text/image data returned
-               "ApplicationName=YourAppName" Set the app name for the connection. MSSQL 2000 and higher only
+               "ApplicationName=YourAppName" - Set the app name for the connection. MSSQL 2000 and higher only
 }
 unit mssqlconn;
 
@@ -395,9 +396,22 @@ const
   ANSI_DEFAULTS_ON: array[boolean] of shortstring = ('SET ANSI_DEFAULTS ON', 'SET QUOTED_IDENTIFIER ON');
   CURSOR_CLOSE_ON_COMMIT_OFF: array[boolean] of shortstring = ('SET CURSOR_CLOSE_ON_COMMIT OFF', 'SET CLOSE ON ENDTRAN OFF');
   VERSION_NUMBER: array[boolean] of shortstring = ('SERVERPROPERTY(''ProductVersion'')', '@@version_number');
+  
+Var
+  B : Boolean;
+    
 begin
   // Do not call the inherited method as it checks for a non-empty DatabaseName, empty DatabaseName=default database defined for login
-  //inherited DoInternalConnect;
+  // MVC: Inherited MUST be called to do housekeeping.
+  B:=DatabaseName='';
+  if B then
+    DatabaseName:='Dummy';
+  try  
+    inherited DoInternalConnect;
+  finally
+    if B then 
+      DatabaseName:='';
+  end;
 
   InitialiseDBLib(DBLibLibraryName);
 
@@ -643,7 +657,8 @@ begin
   case SQLDataType of
     SQLCHAR:             Result:=ftFixedChar;
     SQLVARCHAR:          Result:=ftString;
-    SQLINT1, SQLINT2:    Result:=ftSmallInt;
+    SQLINT1:             Result:=ftWord;
+    SQLINT2:             Result:=ftSmallInt;
     SQLINT4, SQLINTN:    Result:=ftInteger;
     SYBINT8:             Result:=ftLargeInt;
     SQLFLT4, SQLFLT8,
@@ -760,7 +775,7 @@ begin
       inc(dest, sizeof(Word));
       desttype:=SQLBINARY;
       end;
-    ftSmallInt:
+    ftSmallInt, ftWord:
       begin
       desttype:=SQLINT2;
       destlen:=sizeof(DBSMALLINT); //smallint

+ 88 - 103
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -4,7 +4,7 @@
 interface
 
 uses
-  Classes, SysUtils,bufdataset,sqldb,db,dynlibs,ctypes,
+  Classes, SysUtils,bufdataset,sqldb,db,ctypes,
  {$IFDEF mysql55}
   mysql55dyn;
  {$ELSE}
@@ -348,24 +348,24 @@ end;
 
 function TConnectionName.GetAsSQLText(Field : TField) : string;
 
-var esc_str : pchar;
-
 begin
-  if (not assigned(field)) or field.IsNull then Result := 'Null'
-  else if field.DataType = ftString then
-    Result := '''' + EscapeString(field.AsString) + ''''
-  else Result := inherited GetAsSqlText(field);
+  if (not assigned(Field)) or Field.IsNull then
+    Result := 'Null'
+  else if Field.DataType = ftString then
+    Result := '''' + EscapeString(Field.AsString) + ''''
+  else
+    Result := inherited GetAsSqlText(Field);
 end;
 
 function TConnectionName.GetAsSQLText(Param: TParam) : string;
 
-var esc_str : pchar;
-
 begin
-  if (not assigned(param)) or param.IsNull then Result := 'Null'
-  else if param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo,ftBytes,ftVarBytes] then
+  if (not assigned(Param)) or Param.IsNull then
+    Result := 'Null'
+  else if Param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo,ftBytes,ftVarBytes] then
     Result := '''' + EscapeString(Param.AsString) + ''''
-  else Result := inherited GetAsSqlText(Param);
+  else
+    Result := inherited GetAsSqlText(Param);
 end;
 
 
@@ -625,7 +625,10 @@ begin
       end;
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
       begin
-      NewType := ftSmallint;
+      if AField^.flags and UNSIGNED_FLAG <> 0 then
+        NewType := ftWord
+      else
+        NewType := ftSmallint;
       end;
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
@@ -803,6 +806,14 @@ begin
   ABlobBuf^.BlobBuffer^.Size := len;
 end;
 
+function InternalStrToInt(const S: string): integer;
+begin
+  if S = '' then
+    Result := 0
+  else
+    Result := StrToInt(S);
+end;
+
 function InternalStrToFloat(S: string): Extended;
 
 var
@@ -814,7 +825,7 @@ begin
   for I := 1 to Length(S) do
     begin
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
-      Tmp := Tmp + DecimalSeparator
+      Tmp := Tmp + FormatSettings.DecimalSeparator
     else
       Tmp := Tmp + S[I];
     end;
@@ -832,7 +843,7 @@ begin
   for I := 1 to Length(S) do
     begin
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
-      Tmp := Tmp + DecimalSeparator
+      Tmp := Tmp + FormatSettings.DecimalSeparator
     else
       Tmp := Tmp + S[I];
     end;
@@ -923,6 +934,7 @@ var
   VI: Integer;
   VL: LargeInt;
   VS: Smallint;
+  VW: Word;
   VF: Double;
   VC: Currency;
   VD: TDateTime;
@@ -935,131 +947,104 @@ begin
   if Source = Nil then // If the pointer is NULL, the field is NULL
     exit;
   SetString(Src, Source, Len);
-  case AField^.ftype of
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
+
+  if Len > FieldDef.Size then
+    Len := FieldDef.Size;
+
+  case FieldDef.DataType of
+    ftSmallint:
       begin
-      if (Src<>'') then
-        VS := StrToInt(Src)
-      else
-        VS := 0;
-      Move(VS, Dest^, SizeOf(smallint));
+      VS := InternalStrToInt(Src);
+      Move(VS, Dest^, SizeOf(Smallint));
       end;
-    FIELD_TYPE_LONG, FIELD_TYPE_INT24:
+    ftWord:
       begin
-      if (Src<>'') then
-        VI := StrToInt(Src)
-      else
-        VI := 0;
+      VW := InternalStrToInt(Src);
+      Move(VW, Dest^, SizeOf(Word));
+      end;
+    ftInteger, ftAutoInc:
+      begin
+      VI := InternalStrToInt(Src);
       Move(VI, Dest^, SizeOf(Integer));
       end;
-    FIELD_TYPE_LONGLONG:
+    ftLargeInt:
       begin
-      if (Src<>'') then
+      {$IFDEF MYSQL50_UP}
+      if AField^.ftype = FIELD_TYPE_BIT then
+        begin
+        VL := 0;
+        for VI := 0 to Len-1 do
+          VL := VL * 256 + PByte(Source+VI)^;
+        end
+      else
+      {$ENDIF}
+      if Src <> '' then
         VL := StrToInt64(Src)
       else
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
-{$ifdef mysql50_up}
-    FIELD_TYPE_NEWDECIMAL,
-{$endif}      
-    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-      case FieldDef.DataType of
-        ftBCD:
-          begin
-          VC := InternalStrToCurrency(Src);
-          Move(VC, Dest^, SizeOf(Currency));
-          end;
-        ftFmtBCD:
-          begin
-          VB := StrToBCD(Src, FSQLFormatSettings);
-          Move(VB, Dest^, SizeOf(TBCD));
-          end
-        else
-          begin
-          if Src <> '' then
-            VF := InternalStrToFloat(Src)
-          else
-            VF := 0;
-          Move(VF, Dest^, SizeOf(Double));
-          end;
-      end;
-    FIELD_TYPE_TIMESTAMP:
+    ftFloat:
       begin
       if Src <> '' then
-        VD := InternalStrToTimeStamp(Src)
+        VF := InternalStrToFloat(Src)
       else
-        VD := 0;
-      Move(VD, Dest^, SizeOf(TDateTime));
+        VF := 0;
+      Move(VF, Dest^, SizeOf(Double));
+      end;
+    ftBCD:
+      begin
+      VC := InternalStrToCurrency(Src);
+      Move(VC, Dest^, SizeOf(Currency));
       end;
-    FIELD_TYPE_DATETIME:
+    ftFmtBCD:
+      begin
+      VB := StrToBCD(Src, FSQLFormatSettings);
+      Move(VB, Dest^, SizeOf(TBCD));
+      end;
+    ftDate:
       begin
       if Src <> '' then
-        VD := InternalStrToDateTime(Src)
+        VD := InternalStrToDate(Src)
       else
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
-    FIELD_TYPE_DATE:
+    ftTime:
       begin
       if Src <> '' then
-        VD := InternalStrToDate(Src)
+        VD := InternalStrToTime(Src)
       else
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
-    FIELD_TYPE_TIME:
+    ftDateTime:
       begin
       if Src <> '' then
-        VD := InternalStrToTime(Src)
+        if AField^.ftype = FIELD_TYPE_TIMESTAMP then
+          VD := InternalStrToTimeStamp(Src)
+        else
+          VD := InternalStrToDateTime(Src)
       else
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
-    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
+    ftString, ftFixedChar:
+      // String-fields which can contain more then dsMaxStringSize characters
+      // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
       begin
-{      Write('Moving string of size ',asize,' : ');
-      P:=Source;
-      If (P<>nil) then
-        While P[0]<>#0 do
-          begin
-          Write(p[0]);
-          inc(p);
-          end;
-      Writeln;
-}
-      if Len > FieldDef.Size then
-        Len := FieldDef.Size;
-      case FieldDef.DataType of
-        // String-fields which can contain more then dsMaxStringSize characters
-        // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
-        ftBlob, ftMemo:
-          CreateBlob := True;
-        ftVarBytes:
-          begin
-          PWord(Dest)^ := Len;
-          Move(Source^, (Dest+sizeof(Word))^, Len);
-          end;
-        ftBytes:
-          Move(Source^, Dest^, Len);
-        else // ftString, ftFixedChar
-          begin
-          Move(Source^, Dest^, Len);
-          (Dest+Len)^ := #0;
-          end;
+      Move(Source^, Dest^, Len);
+      (Dest+Len)^ := #0;
       end;
-      end;
-    FIELD_TYPE_TINY_BLOB..FIELD_TYPE_BLOB:
-      CreateBlob := True;
-{$IFDEF MYSQL50_UP}
-    FIELD_TYPE_BIT:
+    ftVarBytes:
       begin
-      VL := 0;
-      for VI := 0 to Len-1 do
-        VL := VL * 256 + PByte(Source+VI)^;
-      move(VL, Dest^, sizeof(LargeInt));
+      PWord(Dest)^ := Len;
+      Move(Source^, (Dest+sizeof(Word))^, Len);
       end;
-{$ENDIF}
+    ftBytes:
+      Move(Source^, Dest^, Len);
+    ftBlob, ftMemo:
+      CreateBlob := True;
   end;
   Result := True;
 end;

+ 38 - 17
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -843,8 +843,10 @@ begin
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
-    ftInteger,ftWord,ftAutoInc:   // mapped to TLongintField
+    ftInteger,ftAutoInc:  // mapped to TLongintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
+    ftWord:               // mapped to TWordField
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_USHORT, buffer, SizeOf(Word), @StrLenOrInd);
     ftLargeint:           // mapped to TLargeintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
     ftFloat,ftCurrency:   // mapped to TFloatField
@@ -1088,7 +1090,7 @@ var
   ColName,TypeName:string;
   FieldType:TFieldType;
   FieldSize:word;
-  AutoIncAttr, Updatable, FixedPrecScale: SQLLEN;
+  AutoIncAttr, FixedPrecScale, Unsigned, Updatable: SQLLEN;
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
@@ -1195,7 +1197,6 @@ begin
     // only one column per table can have identity attr.
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     begin
-      AutoIncAttr:=0;
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
                         i,                          // column number
@@ -1208,22 +1209,11 @@ begin
       );
       if (AutoIncAttr=SQL_TRUE) and (FieldType=ftInteger) then
         FieldType:=ftAutoInc;
-    end;
-
-    Updatable:=0;
-    ODBCCheckResult(
-      SQLColAttribute(ODBCCursor.FSTMTHandle,
-                      i,
-                      SQL_DESC_UPDATABLE,
-                      nil,
-                      0,
-                      nil,
-                      @Updatable),
-      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
-    );
-
+    end
+    else
     if FieldType in [ftFloat] then
     begin
+      FixedPrecScale:=0;
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,
                         i,
@@ -1238,6 +1228,37 @@ begin
         FieldType:=ftCurrency;
     end;
 
+    if FieldType in [ftSmallint] then
+    begin
+      Unsigned:=0;
+      ODBCCheckResult(
+        SQLColAttribute(ODBCCursor.FSTMTHandle,
+                        i,
+                        SQL_DESC_UNSIGNED,
+                        nil,
+                        0,
+                        nil,
+                        @Unsigned),
+        SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get unsigned attribute for column %d.',[i]
+      );
+      if Unsigned=SQL_TRUE then
+        case FieldType of
+          ftSmallint: FieldType:=ftWord;
+        end;
+    end;
+
+    Updatable:=0;
+    ODBCCheckResult(
+      SQLColAttribute(ODBCCursor.FSTMTHandle,
+                      i,
+                      SQL_DESC_UPDATABLE,
+                      nil,
+                      0,
+                      nil,
+                      @Updatable),
+      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
+    );
+
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     begin
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness

+ 1 - 0
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -375,6 +375,7 @@ end;
 procedure TPQConnection.DoInternalDisconnect;
 var i:integer;
 begin
+  Inherited;
   for i:=0 to length(FConnectionPool)-1 do
     begin
     if assigned(FConnectionPool[i].FPGConn) then

+ 91 - 71
packages/fcl-db/src/sqldb/sqldb.pp

@@ -41,10 +41,12 @@ type
     WhereStopPos : integer;
   end;
 
+
 type
   TSQLConnection = class;
   TSQLTransaction = class;
   TCustomSQLQuery = class;
+  TCustomSQLStatement = Class;
   TSQLQuery = class;
   TSQLScript = class;
 
@@ -106,7 +108,7 @@ type
     FHostName            : string;
     FCharSet             : string;
     FRole                : String;
-
+    FStatements          : TFPList;
     function GetPort: cardinal;
     function GetStatementInfo(const ASQL: string; Full: Boolean; ASchema : TSchemaType): TSQLStatementInfo;
     procedure SetPort(const AValue: cardinal);
@@ -126,6 +128,8 @@ type
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
     Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
+    Procedure RegisterStatement(S : TCustomSQLStatement);
+    Procedure UnRegisterStatement(S : TCustomSQLStatement);
 
     procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
     procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
@@ -145,6 +149,7 @@ type
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
+    Property Statements : TFPList Read FStatements;
     property Port: cardinal read GetPort write SetPort;
   public
     property Handle: Pointer read GetHandle;
@@ -224,17 +229,19 @@ type
     FOrigSQL : String;
     FServerSQL : String;
     FTransaction: TSQLTransaction;
-    FDatasource : TDatasource;
     FParseSQL: Boolean;
+    FDataLink : TDataLink;
     procedure SetDatabase(AValue: TSQLConnection);
     procedure SetParams(AValue: TParams);
     procedure SetSQL(AValue: TStrings);
     procedure SetTransaction(AValue: TSQLTransaction);
     Function GetPrepared : Boolean;
   Protected
+    Function CreateDataLink : TDataLink; virtual;
     procedure OnChangeSQL(Sender : TObject); virtual;
     function GetDataSource: TDatasource; Virtual;
     procedure SetDataSource(AValue: TDatasource); virtual;
+    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
     procedure AllocateCursor;
     procedure DeAllocateCursor;
     Function GetSchemaType : TSchemaType; virtual;
@@ -285,7 +292,6 @@ type
   private
     // FCheckParams: Boolean;
     // FCursor              : TSQLCursor;
-    FParams: TParams;
     FSchemaType: TSchemaType;
 //    FSQL: TStringlist;
     FUpdateable          : boolean;
@@ -673,13 +679,18 @@ end;
 
 procedure TCustomSQLStatement.SetDataSource(AValue: TDatasource);
 
+
+begin
+  if GetDatasource=AValue then Exit;
+  if (FDataLink=Nil) then
+    FDataLink:=CreateDataLink;
+  FDataLink.DataSource:=AValue;
+end;
+
+procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound : Boolean);
 begin
-  if FDatasource=AValue then Exit;
-  If Assigned(FDatasource) then
-    FDatasource.RemoveFreeNotification(Self);
-  FDatasource:=AValue;
-  If Assigned(FDatasource) then
-    FDatasource.FreeNotification(Self);
+  if Assigned(DataSource) and Assigned(DataSource.Dataset) then
+    FParams.CopyParamValuesFromDataset(DataSource.Dataset,CopyBound);
 end;
 
 procedure TCustomSQLStatement.SetParams(AValue: TParams);
@@ -711,8 +722,8 @@ end;
 
 procedure TCustomSQLStatement.DoExecute;
 begin
-  If (FParams.Count>0) and Assigned(FDatasource) then
-    ; // FMasterLink.CopyParamsFromMaster(False);
+  If (FParams.Count>0) and Assigned(Datasource) then
+    CopyParamsFromMaster(False);
   If LogEvent(detExecute) then
     Log(detExecute,FServerSQL);
   Database.Execute(FCursor,Transaction, FParams);
@@ -723,6 +734,11 @@ begin
   Result := Assigned(FCursor) and FCursor.FPrepared;
 end;
 
+function TCustomSQLStatement.CreateDataLink: TDataLink;
+begin
+  Result:=TDataLink.Create;
+end;
+
 function TCustomSQLStatement.CreateParams: TParams;
 begin
   Result:=TParams.Create(Nil);
@@ -756,7 +772,10 @@ begin
     If (AComponent=FTransaction) then
       FTransaction:=Nil
     else if (AComponent=FDatabase) then
+      begin
+      UnPrepare;
       FDatabase:=Nil;
+      end;
 end;
 
 constructor TCustomSQLStatement.Create(AOwner: TComponent);
@@ -774,6 +793,8 @@ begin
   UnPrepare;
   Transaction:=Nil;
   Database:=Nil;
+  DataSource:=Nil;
+  FreeAndNil(FDataLink);
   FreeAndNil(Fparams);
   FreeAndNil(FSQL);
   inherited Destroy;
@@ -812,13 +833,20 @@ procedure TCustomSQLStatement.AllocateCursor;
 
 begin
   if not assigned(FCursor) then
+    begin
+    // Do this as late as possible.
     FCursor:=Database.AllocateCursorHandle;
+    FDatabase.RegisterStatement(Self);
+    end;
 end;
 
 procedure TCustomSQLStatement.DeAllocateCursor;
 begin
   if Assigned(FCursor) and Assigned(Database) then
+    begin
     DataBase.DeAllocateCursorHandle(FCursor);
+    Database.UnRegisterStatement(Self);
+    end;
 end;
 
 procedure TCustomSQLStatement.DoPrepare;
@@ -860,8 +888,7 @@ begin
   try
     DoPrepare;
   except
-    if assigned(FCursor) then
-      DataBase.DeAllocateCursorHandle(FCursor);
+    DeAllocateCursor;
     Raise;
   end;
 end;
@@ -887,12 +914,18 @@ end;
 
 function TCustomSQLStatement.GetDataSource: TDatasource;
 begin
-  Result:=FDatasource;
+  if Assigned(FDataLink) then
+    Result:=FDataLink.Datasource
+  else
+    Result:=Nil;
 end;
 
 procedure TCustomSQLStatement.Unprepare;
 begin
-  if Prepared then
+  // Some SQLConnections does not support statement [un]preparation, but they have allocated local cursor(s)
+  //  so let them do cleanup f.e. cancel pending queries and/or free resultset
+  //  and also do UnRegisterStatement!
+  if assigned(FCursor) then
     DoUnprepare;
 end;
 
@@ -950,11 +983,20 @@ begin
 end;
 
 procedure TSQLConnection.DoInternalDisconnect;
+
+Var
+  I : integer;
+
 begin
+  For I:=0 to FStatements.Count-1 do
+    TCustomSQLStatement(FStatements[i]).Unprepare;
+  FStatements.Clear;
 end;
 
 destructor TSQLConnection.Destroy;
 begin
+  Connected:=False; // needed because we want to de-allocate statements
+  FreeAndNil(FStatements);
   inherited Destroy;
 end;
 
@@ -974,13 +1016,14 @@ begin
     Transaction.EndTransaction;
 end;
 
-Procedure TSQLConnection.ExecuteDirect(SQL: String);
+procedure TSQLConnection.ExecuteDirect(SQL: String);
 
 begin
   ExecuteDirect(SQL,FTransaction);
 end;
 
-Procedure TSQLConnection.ExecuteDirect(SQL: String; ATransaction : TSQLTransaction);
+procedure TSQLConnection.ExecuteDirect(SQL: String;
+  ATransaction: TSQLTransaction);
 
 var Cursor : TSQLCursor;
 
@@ -1059,6 +1102,7 @@ begin
   inherited Create(AOwner);
   FSQLFormatSettings:=DefaultSQLFormatSettings;
   FFieldNameQuoteChars:=DoubleQuotes;
+  FStatements:=TFPList.Create;
 end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
@@ -1162,6 +1206,17 @@ begin
     end;
 end;
 
+procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
+begin
+  if FStatements.IndexOf(S)=-1 then
+    FStatements.Add(S);
+end;
+
+procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
+begin
+  FStatements.Remove(S);
+end;
+
 procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
 begin
   // empty
@@ -1573,18 +1628,13 @@ end;
 
 procedure TCustomSQLQuery.InternalClose;
 begin
-  if not IsReadFromPacket then
+  if assigned(Cursor) then
     begin
-    if assigned(Cursor) and Cursor.FSelectable then
+    if Cursor.FSelectable then
       FreeFldBuffers;
     // Some SQLConnections does not support statement [un]preparation,
     //  so let them do cleanup f.e. cancel pending queries and/or free resultset
     if not Prepared then FStatement.DoUnprepare;
-    end
-  else
-    begin
-    if assigned(Cursor) then
-      FStatement.DeAllocateCursor;
     end;
   if DefaultFields then
     DestroyFields;
@@ -1631,7 +1681,8 @@ begin
 end;
 *)
 
-Function TSQLConnection.GetStatementInfo(const ASQL : string; Full : Boolean; ASchema : TSchemaType) : TSQLStatementInfo;
+function TSQLConnection.GetStatementInfo(const ASQL: string; Full: Boolean;
+  ASchema: TSchemaType): TSQLStatementInfo;
 
 
 type TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
@@ -1810,24 +1861,22 @@ procedure TCustomSQLQuery.InternalOpen;
 var tel, fieldc : integer;
     f           : TField;
     IndexFields : TStrings;
-    ReadFromFile: Boolean;
 begin
-  ReadFromFile:=IsReadFromPacket;
-  if ReadFromFile then
+  if IsReadFromPacket then
     begin
-    FStatement.AllocateCursor;
-    Cursor.FSelectable:=True;
-    Cursor.FStatementType:=stSelect;
+    // When we read from file there is no need for Cursor, also note that Database may not be assigned
+    //FStatement.AllocateCursor;
+    //Cursor.FSelectable:=True;
+    //Cursor.FStatementType:=stSelect;
     FUpdateable:=True;
+    BindFields(True);
     end
   else
+    begin
     Prepare;
+    if not Cursor.FSelectable then
+      DatabaseError(SErrNoSelectStatement,Self);
 
-  if not Cursor.FSelectable then
-    DatabaseError(SErrNoSelectStatement,Self);
-
-  if not ReadFromFile then
-    begin
     // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
     // which do not allow processing multiple recordsets at a time. (Microsoft
     // calls this MARS, see bug 13241)
@@ -1869,9 +1918,7 @@ begin
       end
     else
       BindFields(True);
-    end
-  else
-    BindFields(True);
+    end;
 
   if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
     begin
@@ -1903,39 +1950,20 @@ Type
 
   TQuerySQLStatement = Class(TCustomSQLStatement)
   protected
-    FMasterLink: TMasterParamsDataLink;
     FQuery : TCustomSQLQuery;
-    function GetDataSource: TDatasource; override;
-    procedure SetDataSource(AValue: TDatasource); override;
+    Function CreateDataLink : TDataLink; override;
     Function GetSchemaType : TSchemaType; override;
     Function GetSchemaObjectName : String; override;
     Function GetSchemaPattern: String; override;
     procedure GetStatementInfo(Var ASQL: String; Full: Boolean; ASchema: TSchemaType; out Info: TSQLStatementInfo); override;
     procedure OnChangeSQL(Sender : TObject); override;
-  Public
-    destructor Destroy; override;
   end;
 
 { TQuerySQLStatement }
 
-function TQuerySQLStatement.GetDataSource: TDatasource;
+function TQuerySQLStatement.CreateDataLink: TDataLink;
 begin
-  Result:=inherited GetDataSource;
-
-end;
-
-procedure TQuerySQLStatement.SetDataSource(AValue: TDatasource);
-begin
-  inherited SetDataSource(AValue);
-  If Assigned(AValue) then
-    begin
-    AValue.FreeNotification(Self);
-    If (FMasterLink=Nil) then
-      FMasterLink:=TMasterParamsDataLink.Create(FQuery);
-    FMasterLink.Datasource:=AValue;
-    end
-  else
-    FreeAndNil(FMasterLink);
+  Result:=TMasterParamsDataLink.Create(FQuery);
 end;
 
 function TQuerySQLStatement.GetSchemaType: TSchemaType;
@@ -1981,17 +2009,11 @@ procedure TQuerySQLStatement.OnChangeSQL(Sender: TObject);
 begin
   UnPrepare;
   inherited OnChangeSQL(Sender);
-  If CheckParams and Assigned(FMasterLink) then
-    FMasterLink.RefreshParamNames;
+  If CheckParams and Assigned(FDataLink) then
+    (FDataLink as TMasterParamsDataLink).RefreshParamNames;
   FQuery.ServerIndexDefs.Updated:=false;
 end;
 
-destructor TQuerySQLStatement.Destroy;
-begin
-  FreeAndNil(FMasterLink);
-  inherited Destroy;
-end;
-
 constructor TCustomSQLQuery.Create(AOwner : TComponent);
 
 Var
@@ -1999,7 +2021,6 @@ Var
 
 begin
   inherited Create(AOwner);
-  FParams := TParams.create(self);
   F:=TQuerySQLStatement.Create(Self);
   F.FQuery:=Self;
   FStatement:=F;
@@ -2034,7 +2055,6 @@ begin
   if Active then Close;
   UnPrepare;
   FreeAndNil(Fstatement);
-  FreeAndNil(FParams);
 //  FreeAndNil(FSQL);
   FreeAndNil(FInsertSQL);
   FreeAndNil(FDeleteSQL);

+ 9 - 6
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -374,13 +374,14 @@ Type
   end;
   
 Const
-  FieldMapCount = 27;
+  FieldMapCount = 28;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
-   (n:'LARGEINT'; t:ftlargeInt),
-   (n:'BIGINT'; t:ftlargeInt),
-   (n:'WORD'; t: ftWord),
+   (n:'LARGEINT'; t:ftLargeInt),
+   (n:'BIGINT'; t:ftLargeInt),
    (n:'SMALLINT'; t: ftSmallint),
+   (n:'TINYINT'; t: ftSmallint),
+   (n:'WORD'; t: ftWord),
    (n:'BOOLEAN'; t: ftBoolean),
    (n:'REAL'; t: ftFloat),
    (n:'FLOAT'; t: ftFloat),
@@ -395,8 +396,8 @@ Const
    (n:'CHAR'; t: ftFixedChar),
    (n:'NUMERIC'; t: ftBCD),
    (n:'DECIMAL'; t: ftBCD),
-   (n:'TEXT'; t: ftmemo),
-   (n:'CLOB'; t: ftmemo),
+   (n:'TEXT'; t: ftMemo),
+   (n:'CLOB'; t: ftMemo),
    (n:'BLOB'; t: ftBlob),
    (n:'NCHAR'; t: ftFixedWideChar),
    (n:'NVARCHAR'; t: ftWideString),
@@ -731,6 +732,7 @@ procedure TSQLite3Connection.DoInternalConnect;
 var
   str1: string;
 begin
+  Inherited;
   if Length(databasename)=0 then
     DatabaseError(SErrNoDatabaseName,self);
   InitializeSqlite(SQLiteDefaultLibrary);
@@ -745,6 +747,7 @@ end;
 procedure TSQLite3Connection.DoInternalDisconnect;
 
 begin
+  Inherited;
   if fhandle <> nil then 
     begin
     checkerror(sqlite3_close(fhandle));

+ 1 - 0
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -230,6 +230,7 @@ begin
       end;
     ssMySQL:
       begin
+      FieldtypeDefinitions[ftWord] := 'SMALLINT UNSIGNED';
       //MySQL recognizes BOOLEAN, but as synonym for TINYINT, not true sql boolean datatype
       FieldtypeDefinitions[ftBoolean]  := '';
       // Use 'DATETIME' for datetime-fields instead of timestamp, because

+ 59 - 30
packages/fcl-db/tests/testfieldtypes.pas

@@ -6,7 +6,7 @@ unit TestFieldTypes;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,
+  Classes, SysUtils, fpcunit, testregistry,
   db;
 
 type
@@ -24,7 +24,7 @@ type
     procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
       ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
       ACheckFieldValueProc: TCheckFieldValueProc);
-    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
+    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuesCount : integer; Cross : boolean = false);
     procedure TestSetBlobAsParam(asWhat : integer);
   protected
     procedure SetUp; override;
@@ -57,7 +57,6 @@ type
     procedure TestNonNullableParams;
     procedure TestDblQuoteEscComments;
     procedure TestpfInUpdateFlag; // bug 7565
-    procedure TestScript;
     procedure TestInsertReturningQuery;
     procedure TestOpenStoredProc;
     procedure TestOpenSpecialStatements;
@@ -76,6 +75,7 @@ type
 
     procedure TestLargeRecordSize;
     procedure TestInt;
+    procedure TestTinyint;
     procedure TestNumeric;
     procedure TestFloat;
     procedure TestDate;
@@ -203,33 +203,6 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.TestScript;
-
-var Ascript : TSQLScript;
-
-begin
-  Ascript := tsqlscript.create(nil);
-  try
-    with Ascript do
-      begin
-      DataBase := TSQLDBConnector(DBConnector).Connection;
-      transaction := TSQLDBConnector(DBConnector).Transaction;
-      script.clear;
-      script.append('create table a (id int);');
-      script.append('create table b (id int);');
-      ExecuteScript;
-      // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-      TSQLDBConnector(DBConnector).CommitDDL;
-      end;
-  finally
-    AScript.Free;
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
-    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-    TSQLDBConnector(DBConnector).CommitDDL;
-  end;
-end;
-
 procedure TTestFieldTypes.TestLargeRecordSize;
 
 begin
@@ -304,6 +277,62 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestTinyint;
+const
+  testValuesCount = 5;
+  testValues : Array[0..testValuesCount-1] of byte = (0,1,127,128,255);
+var
+  datatype: string;
+  fieldtype: TFieldType;
+  i: integer;
+begin
+  case SQLServerType of
+    ssMSSQL:
+      begin
+      datatype  := 'TINYINT';
+      fieldtype := ftWord;
+      end;
+    ssMySQL:
+      begin
+      datatype  := 'TINYINT UNSIGNED';
+      fieldtype := ftWord;
+      end;
+    ssSQLite:
+      begin
+      datatype  := 'TINYINT';
+      fieldtype := ftSmallint;
+      end;
+    else
+      begin
+      fieldtype := ftSmallint;
+      datatype  := FieldtypeDefinitions[fieldtype];
+      end;
+  end;
+
+  CreateTableWithFieldType(fieldtype, datatype);
+  TestFieldDeclaration(fieldtype, sizeof(Smallint));
+
+  with TSQLDBConnector(DBConnector) do
+  begin
+    Query.Open;
+    for i := 0 to testValuesCount-1 do
+      Query.AppendRecord([testValues[i]]);
+    Query.ApplyUpdates;
+    Query.Close;
+
+    for i := 0 to testValuesCount-1 do
+      ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testValues[i]) + ')');
+
+    Query.Open;
+    for i := 0 to testValuesCount*2-1 do
+    begin
+      AssertEquals(testValues[i mod testValuesCount], Query.Fields[0].AsInteger);
+      Query.Next;
+    end;
+    Query.Close;
+  end;
+end;
+
 procedure TTestFieldTypes.TestNumeric;
 
 const

+ 3 - 0
packages/fcl-db/tests/testleaks.sh

@@ -5,6 +5,9 @@ if [ $? != 0 ]; then
   echo "Compilation failed";
   exit
 fi
+echo "Generating test list"
+./dbtestframework --list 2>/dev/null | sed /TestSuites/d | tr -d '[:blank:]' > test-list.txt 
+exit
 for f in `cat test-list.txt`
 do
   echo -n "Doing test $f"

+ 58 - 0
packages/fcl-db/tests/testsqldb.pas

@@ -27,6 +27,7 @@ type
   TTestTSQLQuery = class(TSQLDBTestCase)
   private
   published
+    procedure TestMasterDetail;
     procedure TestUpdateServerIndexDefs;
   end;
 
@@ -38,13 +39,43 @@ type
     procedure ReplaceMe;
   end;
 
+  { TTestTSQLScript }
+
+  TTestTSQLScript = class(TSQLDBTestCase)
+  published
+    procedure TestExecuteScript;
+  end;
 
 implementation
 
 uses sqldbtoolsunit, toolsunit, sqldb;
 
+
 { TTestTSQLQuery }
 
+procedure TTestTSQLQuery.TestMasterDetail;
+var MasterQuery, DetailQuery: TSQLQuery;
+    MasterSource: TDataSource;
+begin
+  with TSQLDBConnector(DBConnector) do
+  try
+    MasterQuery := GetNDataset(10) as TSQLQuery;
+    MasterSource := TDatasource.Create(nil);
+    MasterSource.DataSet := MasterQuery;
+    DetailQuery := Query;
+    DetailQuery.SQL.Text := 'select NAME from FPDEV where ID=:ID';
+    DetailQuery.DataSource := MasterSource;
+
+    MasterQuery.Open;
+    DetailQuery.Open;
+    CheckEquals('TestName1', DetailQuery.Fields[0].AsString);
+    MasterQuery.MoveBy(3);
+    CheckEquals('TestName4', DetailQuery.Fields[0].AsString);
+  finally
+    MasterSource.Free;
+  end;
+end;
+
 procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
 var Q: TSQLQuery;
     name1, name2, name3: string;
@@ -115,6 +146,32 @@ begin
   // replace this procedure with any test for TSQLConnection
 end;
 
+{ TTestTSQLScript }
+
+procedure TTestTSQLScript.TestExecuteScript;
+var Ascript : TSQLScript;
+begin
+  Ascript := TSQLScript.Create(nil);
+  try
+    with Ascript do
+      begin
+      DataBase := TSQLDBConnector(DBConnector).Connection;
+      Transaction := TSQLDBConnector(DBConnector).Transaction;
+      Script.Clear;
+      Script.Append('create table a (id int);');
+      Script.Append('create table b (id int);');
+      ExecuteScript;
+      // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+      TSQLDBConnector(DBConnector).CommitDDL;
+      end;
+  finally
+    AScript.Free;
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).CommitDDL;
+  end;
+end;
 
 { TSQLDBTestCase }
 
@@ -141,5 +198,6 @@ initialization
   begin
     RegisterTest(TTestTSQLQuery);
     RegisterTest(TTestTSQLConnection);
+    RegisterTest(TTestTSQLScript);
   end;
 end.