* 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

@@ -52,6 +52,7 @@ type
     procedure TestpfInUpdateFlag; // bug 7565
     procedure TestInt;
     procedure TestScript;
+    procedure TestInsertReturningQuery;
 
     procedure TestTemporaryTable;
 
@@ -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.