* Fix+Test for bug #27068 : coCheckRowsAffected

git-svn-id: trunk@29113 -

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

@@ -117,6 +117,7 @@ Resourcestring
   SErrNoImplicitTransaction   = 'Connection %s does not allow implicit transactions.';
   SErrImplictTransactionStart = 'Error: attempt to implicitly start a transaction on Connection "%s", transaction "%s".';
   SErrImplicitConnect         = 'Error: attempt to implicitly activate connection "%s".';
+  SErrFailedToUpdateRecord    = '%q: Failed to apply record updates: %d rows updated.';
 
 Implementation
 

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

@@ -27,7 +27,7 @@ type
   TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction);
   TConnOptions= set of TConnOption;
 
-  TConnectionOption = (coExplicitConnect);
+  TConnectionOption = (coExplicitConnect,coCheckRowsAffected);
   TConnectionOptions = Set of TConnectionOption;
 
   TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
@@ -1671,6 +1671,8 @@ begin
     ApplyFieldUpdate(Query.Cursor,P as TSQLDBParam,Fld,B);
     end;
   Qry.execute;
+  if (coCheckRowsAffected in Options) and (Qry.RowsAffected<>1) then
+    DatabaseErrorFmt(SErrFailedToUpdateRecord,[Qry.RowsAffected],Query);
 end;
 
 procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);

packages/fcl-db/tests/testsqldb.pas

@@ -32,8 +32,11 @@ type
     FMyQ: TSQLQuery;
     procedure DoAfterPost(DataSet: TDataSet);
     Procedure Allow;
+    Procedure DoApplyUpdates;
     Procedure SetQueryOPtions;
     Procedure TrySetPacketRecords;
+  Protected
+    Procedure setup; override;
   published
     procedure TestMasterDetail;
     procedure TestUpdateServerIndexDefs;
@@ -42,6 +45,7 @@ type
     Procedure TestCheckSettingsOnlyWhenInactive;
     Procedure TestAutoApplyUpdatesPost;
     Procedure TestAutoApplyUpdatesDelete;
+    Procedure TestCheckRowsAffected;
   end;
 
   { TTestTSQLConnection }
@@ -219,6 +223,12 @@ begin
   FMyQ.PacketRecords:=10;
 end;
 
+Procedure TTestTSQLQuery.setup;
+begin
+  inherited setup;
+  SQLDBConnector.Connection.Options:=[];
+end;
+
 Procedure TTestTSQLQuery.TestDisconnectedPacketRecords;
 begin
   with SQLDBConnector do
@@ -298,6 +308,7 @@ begin
 end;
 
 Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
+
 var Q: TSQLQuery;
     I, J : Integer;
 begin
@@ -333,6 +344,42 @@ begin
     end;
 end;
 
+Procedure TTestTSQLQuery.DoApplyUpdates;
+
+begin
+  FMyQ.ApplyUpdates();
+end;
+
+Procedure TTestTSQLQuery.TestCheckRowsAffected;
+var Q: TSQLQuery;
+    I, J : Integer;
+begin
+  // Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
+  with SQLDBConnector do
+    begin
+    try
+      ExecuteDirect('DROP table testdiscon');
+    except
+      // Ignore
+    end;
+    ExecuteDirect('create table testdiscon (id integer not null, a varchar(10), constraint pk_testdiscon primary key(id))');
+    Transaction.COmmit;
+    for I:=1 to 2 do
+      ExecuteDirect(Format('INSERT INTO testdiscon values (%d,''%.6d'')',[i,i]));
+    Transaction.COmmit;
+    SQLDBConnector.Connection.Options:=[coCheckRowsAffected];
+    Q := SQLDBConnector.Query;
+    Q.SQL.Text:='select * from testdiscon';
+    Q.DeleteSQL.Text:='delete from testdiscon';
+    Q.Open;
+    AssertEquals('Got all records',2,Q.RecordCount);
+    // Now check editing
+    Q.Delete;
+    FMyQ:=Q;
+    AssertException('Rowsaffected > 1 raises exception',EUpdateError,@DoApplyUpdates);
+    end;
+end;
+
 
 { TTestTSQLConnection }