* SQLdb now handles queries with statementtype stExecProcedure as select queries so that it is possible to fetch the results. But stExecProcedure will fetch only one row of data.

* TIBConnection now sets the statement type of a call to a stored procedures to stExecProcedure. This also works for "insert into .. returning" queries. (+test)

git-svn-id: trunk@12454 -

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

@@ -519,6 +519,10 @@ procedure TIBConnection.PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLT
 var dh    : pointer;
     tr    : pointer;
     x     : shortint;
+    info_request   : string;
+    resbuf         : array[0..7] of byte;
+    blockSize      : integer;
+    IBStatementType: integer;
 
 begin
   with cursor as TIBcursor do
@@ -553,7 +557,22 @@ begin
       end
     else
       AllocSQLDA(in_SQLDA,0);
-    if FStatementType = stselect then
+
+    // Get the statement type from firebird/interbase
+    info_request := chr(isc_info_sql_stmt_type);
+    if isc_dsql_sql_info(@Status[0],@Statement,Length(info_request), @info_request[1],sizeof(resbuf),@resbuf) <> 0 then
+      CheckError('PrepareStatement', Status);
+    assert(resbuf[0]=isc_info_sql_stmt_type);
+    BlockSize:=isc_vax_integer(@resbuf[1],2);
+    IBStatementType:=isc_vax_integer(@resbuf[3],blockSize);
+    assert(resbuf[3+blockSize]=isc_info_end);
+    // If the statementtype is isc_info_sql_stmt_exec_procedure then
+    // override the statement type derrived by parsing the query.
+    // This to recognize statements like 'insert into .. returning' correctly
+    if IBStatementType = isc_info_sql_stmt_exec_procedure then
+      FStatementType := stExecProcedure;
+
+    if FStatementType in [stSelect,stExecProcedure] then
       begin
       if isc_dsql_describe(@Status[0], @Statement, 1, SQLDA) <> 0 then
         CheckError('PrepareSelect', Status);

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

@@ -930,7 +930,7 @@ begin
     else
       Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
 
-    if (FCursor.FStatementType = stSelect) then
+    if (FCursor.FStatementType in [stSelect,stExecProcedure]) then
       FCursor.FInitFieldDef := True;
     end;
 end;
@@ -955,11 +955,13 @@ end;
 
 function TCustomSQLQuery.Fetch : boolean;
 begin
-  if not (Fcursor.FStatementType in [stSelect]) then
+  if not (Fcursor.FStatementType in [stSelect,stExecProcedure]) then
     Exit;
 
   if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(Fcursor);
   Result := not FIsEOF;
+  // A stored procedure is always at EOF after its first fetch
+  if FCursor.FStatementType = stExecProcedure then FIsEOF := True;
 end;
 
 procedure TCustomSQLQuery.Execute;
@@ -990,7 +992,7 @@ end;
 
 procedure TCustomSQLQuery.InternalClose;
 begin
-  if StatementType = stSelect then FreeFldBuffers;
+  if StatementType in [stSelect,stExecProcedure] then FreeFldBuffers;
 // Database and FCursor could be nil, for example if the database is not assigned, and .open is called
   if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(FCursor);
   if DefaultFields then
@@ -1178,7 +1180,7 @@ begin
   try
     ReadFromFile:=IsReadFromPacket;
     Prepare;
-    if FCursor.FStatementType in [stSelect] then
+    if FCursor.FStatementType in [stSelect,stExecProcedure] then
       begin
       if not ReadFromFile then
         begin

packages/fcl-db/tests/testfieldtypes.pas

@@ -23,7 +23,7 @@ type
     procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
     procedure TestSetBlobAsParam(asWhat : integer);
   protected
-    procedure SetUp; override; 
+    procedure SetUp; override;
     procedure TearDown; override;
     procedure RunTest; override;
   published
@@ -52,6 +52,7 @@ type
     procedure TestpfInUpdateFlag; // bug 7565
     procedure TestInt;
     procedure TestScript;
+    procedure TestInsertReturningQuery;
 
     procedure TestTemporaryTable;
 
@@ -430,7 +431,7 @@ begin
       free;
       end;
     AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
-    
+
     ApplyUpdates(0);
 
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
@@ -540,7 +541,7 @@ var
 begin
   CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
   TestFieldDeclaration(ftDateTime,8);
-  
+
   if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
     else corrTestValueCount := testValuesCount;
 
@@ -652,7 +653,7 @@ begin
     Params.ParamByName('field1').AsInteger := 5;
     Params.ParamByName('field2').AsInteger := 2;
     ExecSQL;
-    
+
     sql.clear;
     sql.append('select * from FPDEV2 order by FIELD1');
     open;
@@ -884,12 +885,12 @@ begin
     end;
 end;
 
-procedure TTestFieldTypes.SetUp; 
+procedure TTestFieldTypes.SetUp;
 begin
   InitialiseDBConnector;
 end;
 
-procedure TTestFieldTypes.TearDown; 
+procedure TTestFieldTypes.TearDown;
 begin
   if assigned(DBConnector) then
     TSQLDBConnector(DBConnector).Transaction.Rollback;
@@ -902,6 +903,22 @@ begin
     inherited RunTest;
 end;
 
+procedure TTestFieldTypes.TestInsertReturningQuery;
+begin
+  if (SQLDbType <> interbase) then Ignore('This test does only apply to Firebird.');
+  with TSQLDBConnector(DBConnector) do
+    begin
+    // This only works with databases that supports 'insert into .. returning'
+    // for example, Firebird version 2.0 and up
+    CreateTableWithFieldType(ftInteger,'int');
+    Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
+    Query.Open;
+    AssertEquals('FT',Query.fields[0].FieldName);
+    AssertEquals(154,Query.fields[0].AsInteger);
+    Query.Close;
+    end;
+end;
+
 procedure TTestFieldTypes.TestClearUpdateableStatus;
 // Test if CanModify is correctly disabled in case of a select query without
 // a from-statement.
@@ -960,7 +977,7 @@ begin
       post;
       Applyupdates;
       close;
-      
+
       // If ParseSQL is true, but the supplied query isn't updateable, then
       // the query shouldn't be updateable after open.
       ReadOnly := False;
@@ -1045,7 +1062,7 @@ begin
       AssertTrue (assigned(FindField('ID_1')));
       AssertTrue(assigned(FindField('NAME')));
       AssertTrue(assigned(FindField('NAME_1')));
-      
+
       AssertEquals(1,fieldbyname('ID').AsInteger);
       AssertEquals(1,fieldbyname('ID_1').AsInteger);
       AssertEquals('TestName1',fieldbyname('NAME').AsString);
@@ -1468,7 +1485,7 @@ begin
 
     Open;
     close;
-    
+
     SQL.Clear;
     SQL.Add('select blaise from FPDEV');
     passed := false;