--- Merging r13968 into '.':

U    packages/fcl-db/tests/testfieldtypes.pas
--- Merging r13969 into '.':
G    packages/fcl-db/tests/testfieldtypes.pas
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r13971 into '.':
G    packages/fcl-db/tests/testfieldtypes.pas
G    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
U    packages/fcl-db/src/base/dbconst.pas
--- Merging r14023 into '.':
U    packages/fcl-db/src/sqlite/customsqliteds.pas
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Merging r14028 into '.':
U    tests/webtbs/tw11369.pp
--- Merging r14039 into '.':
U    packages/libxml/src/parser.inc
--- Merging r14056 into '.':
G    packages/libxml/src/parser.inc

# revisions: 13968,13969,13971,14023,14028,14039,14056
------------------------------------------------------------------------
r13968 | joost | 2009-10-29 21:26:32 +0100 (Thu, 29 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * Use capitalized table names in tests for MySQL
------------------------------------------------------------------------
------------------------------------------------------------------------
r13969 | joost | 2009-10-29 22:18:54 +0100 (Thu, 29 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * Raise an exception when a query is executed with a parameter set to null when this is not allowed + test
------------------------------------------------------------------------
------------------------------------------------------------------------
r13971 | joost | 2009-10-30 10:41:39 +0100 (Fri, 30 Oct 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/dbconst.pas
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * Better fix for r13969. Let the database-server handle invalid null-parameters. Tip from Martin Schreiber
------------------------------------------------------------------------
------------------------------------------------------------------------
r14023 | blikblum | 2009-11-03 23:20:12 +0100 (Tue, 03 Nov 2009) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqlite3ds.pas
   M /trunk/packages/fcl-db/src/sqlite/sqliteds.pas

* Fix visibility of methods
------------------------------------------------------------------------
------------------------------------------------------------------------
r14028 | hajny | 2009-11-03 23:56:39 +0100 (Tue, 03 Nov 2009) | 1 line
Changed paths:
   M /trunk/tests/webtbs/tw11369.pp

  * Fix by Giulio: Fix test for go32v2
------------------------------------------------------------------------
------------------------------------------------------------------------
r14039 | ivost | 2009-11-04 12:11:09 +0100 (Wed, 04 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/libxml/src/parser.inc

* fixed wrong type

------------------------------------------------------------------------
------------------------------------------------------------------------
r14056 | ivost | 2009-11-04 18:34:38 +0100 (Wed, 04 Nov 2009) | 2 lines
Changed paths:
   M /trunk/packages/libxml/src/parser.inc

* added XML_SAX2_MAGIC constant

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14678 -

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

@@ -95,7 +95,6 @@ Resourcestring
   SMaxIndexes              = 'The maximum amount of indexes is reached';
   SMinIndexes              = 'The minimum amount of indexes is 1';
   STooManyFields           = 'More fields specified then really exist';
-  SNullParamNotAllowed     = 'The parameter ''%s'' does not allow null-values';
 // These are added for Delphi-compatilility, but not used by the fcl:
   SFieldIndexError         = 'Field index out of range';
   SIndexFieldMissing       = 'Cannot access index field ''%s''';

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

@@ -555,7 +555,12 @@ begin
           SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen+2)
         else
           SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen);
-        if (sqltype and 1) = 1 then New(SQLInd);
+        // Always force the creation of slqind for parameters. It could be
+        // that a database-trigger takes care of inserting null-values, so
+        // it should always be possible to pass null-parameters. If that fails,
+        // the database-server will generate the appropiate error.
+        sqltype := sqltype or 1;
+        new(sqlind);
         end;
       {$R+}
       end
@@ -778,13 +783,10 @@ begin
     ParNr := ParamBinding[SQLVarNr];
     VSQLVar := @in_sqlda^.SQLvar[SQLVarNr];
     if AParams[ParNr].IsNull then
-      begin
-      If Assigned(VSQLVar^.SQLInd) then
-        VSQLVar^.SQLInd^ := -1;
-      end
+      VSQLVar^.SQLInd^ := -1
     else
       begin
-      if assigned(VSQLVar^.SQLInd) then VSQLVar^.SQLInd^ := 0;
+      VSQLVar^.SQLInd^ := 0;
 
       case (VSQLVar^.sqltype and not 1) of
         SQL_LONG :

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

@@ -161,7 +161,6 @@ type
     //TDataSet overrides
     function AllocRecordBuffer: PChar; override;
     procedure ClearCalcFields(Buffer: PChar); override;
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     procedure DoBeforeClose; override;
     procedure DoAfterInsert; override;
     procedure DoBeforeInsert; override;
@@ -191,19 +190,20 @@ type
     procedure SetExpectedAppends(AValue: Integer);
     procedure SetExpectedUpdates(AValue: Integer);
     procedure SetExpectedDeletes(AValue: Integer);
-    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
-    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
     procedure SetRecNo(Value: Integer); override;
   public
     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 GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
     function Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean; override;
     function LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
     function Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
     // Additional procedures
     function ApplyUpdates: Boolean;
     procedure ClearUpdates(RecordStates: TRecordStateSet = [rsAdded, rsDeleted, rsUpdated]);

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

@@ -44,14 +44,13 @@ type
   { TSqlite3Dataset }
 
   TSqlite3Dataset = class(TCustomSqliteDataset)
-  private
-    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
-    function InternalGetHandle: Pointer; override;
-    procedure InternalCloseHandle; override;
-    procedure BuildLinkedList; override;
   protected
+    procedure BuildLinkedList; override;
     function GetRowsAffected:Integer; override;
+    procedure InternalCloseHandle; override;
+    function InternalGetHandle: Pointer; override;
     procedure RetrieveFieldDefs; override;
+    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
   public
     procedure ExecuteDirect(const ASQL: String); override;
     function QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects: Boolean): String; override;

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

@@ -45,14 +45,14 @@ type
 
   TSqliteDataset = class(TCustomSqliteDataset)
   private
-    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
-    function InternalGetHandle: Pointer; override;
     function GetSqliteEncoding: String;
-    procedure InternalCloseHandle; override;
-    procedure BuildLinkedList; override;
   protected
-    procedure RetrieveFieldDefs; override;
+    procedure BuildLinkedList; override;
     function GetRowsAffected:Integer; override;
+    function InternalGetHandle: Pointer; override;
+    procedure InternalCloseHandle; override;
+    procedure RetrieveFieldDefs; override;
+    function SqliteExec(ASQL: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; override;
   public
     procedure ExecuteDirect(const ASQL: String); override;
     function QuickQuery(const ASQL: String; const AStrList: TStrings; FillObjects: Boolean): String; override;

packages/fcl-db/tests/testfieldtypes.pas

@@ -48,6 +48,7 @@ type
     procedure TestSetBlobAsMemoParam;
     procedure TestSetBlobAsBlobParam;
     procedure TestSetBlobAsStringParam;
+    procedure TestNonNullableParams;
     procedure TestGetIndexDefs;
     procedure TestDblQuoteEscComments;
     procedure TestpfInUpdateFlag; // bug 7565
@@ -926,7 +927,35 @@ end;
 
 procedure TTestFieldTypes.TestEmptyUpdateQuery;
 begin
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update fpdev set name=''nothing'' where (1=0)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
+end;
+
+procedure TTestFieldTypes.TestNonNullableParams;
+var ASQLQuery : TSQLQuery;
+    Passed: Boolean;
+begin
+  // Check for an exception when a null value is stored into a non-nullable
+  // field using a parameter
+  // There was a bug in IBConnection so that in this case the last used value
+  // for the parameter was used.
+
+  // To make sure that any changes are cancelled in the case the test fails
+  TSQLDBConnector(DBConnector).GetNDataset(true,5);
+
+  ASQLQuery := TSQLDBConnector(DBConnector).Query;
+  ASQLQuery.SQL.text := 'update fpdev set ID=:ID1 where id = :ID2';
+  ASQLQuery.Params[0].Clear;
+  ASQLQuery.Params[1].AsInteger := 1;
+  AssertTrue(ASQLQuery.Params[0].IsNull);
+  Passed:=False;
+  try
+    @ASQLQuery.ExecSQL;
+  except
+    on E: Exception do
+      if E.ClassType.InheritsFrom(EDatabaseError) then
+        Passed := true;
+  end;
+  AssertTrue(Passed);
 end;
 
 procedure TTestFieldTypes.TestStringLargerThen8192;
@@ -1238,7 +1267,7 @@ begin
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
     Connection.ExecuteDirect('insert into FPDEV2(ID,"NAME-TEST") values (1,''test1'')');
-    Query.SQL.Text := 'select * from fpdev2';
+    Query.SQL.Text := 'select * from FPDEV2';
     Query.Open;
     AssertEquals(1,Query.FieldByName('ID').AsInteger);
     AssertEquals('test1',Query.FieldByName('NAME-TEST').AsString);

packages/libxml/src/parser.inc

@@ -618,7 +618,7 @@
  * Returns 1 if true
  *)
   hasExternalSubsetSAXFunc = function(ctx: pointer): cint; EXTDECL;
-
+{$ENDIF}
 
 (************************************************************************
  *									*
@@ -630,8 +630,11 @@
  *
  * Special constant found in SAX2 blocks initialized fields
  *)
-{$DEFINE XML_SAX2_MAGIC := $DEEDBEAF}
+{$IFDEF CONST}
+  XML_SAX2_MAGIC = $DEEDBEAF;
+{$ENDIF}
 
+{$IFDEF TYPE}
 (**
  * startElementNsSAX2Func:
  * @ctx:  the user data (XML parser context)
@@ -954,7 +957,7 @@ function xmlReadDoc(cur: xmlCharPtr; URL, encoding: pchar; options: cint): xmlDo
 function xmlReadFile(filename, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
 function xmlReadMemory(buffer: pchar; size: cint; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
 function xmlReadFd(fd: cint; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
-function xmlReadIO(ioread: xmlInputReadCallback; ioclose: xmlInputCloseCallback; ioctx: pchar; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
+function xmlReadIO(ioread: xmlInputReadCallback; ioclose: xmlInputCloseCallback; ioctx: pointer; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
 function xmlCtxtReadDoc(ctxt: xmlParserCtxtPtr; cur: xmlCharPtr; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
 function xmlCtxtReadFile(ctxt: xmlParserCtxtPtr; filename, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;
 function xmlCtxtReadMemory(ctxt: xmlParserCtxtPtr; buffer: pchar; size: cint; URL, encoding: pchar; options: cint): xmlDocPtr; EXTDECL; external xml2lib;

tests/webtbs/tw11369.pp

@@ -4,7 +4,7 @@
 
 // The curterm6 case in the manual warrants a separate bug report
 
-{$if defined(darwin) or defined(os2) or defined(emx) or defined(palmos) or defined(symbian) or defined(watcom) or defined(wdosx) or defined(win32) or defined(wince)}
+{$if defined(darwin) or defined(os2) or defined(emx) or defined(palmos) or defined(symbian) or defined(watcom) or defined(wdosx) or defined(win32) or defined(wince) or defined(go32v2)}
 {$define underscoreprefix}
 {$endif}