* Improve support for returnvalues of calling statements.

git-svn-id: trunk@19303 -

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

@@ -669,12 +669,19 @@ end;
 
 procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams);
 var tr : pointer;
+    out_SQLDA : PXSQLDA;
 begin
   tr := aTransaction.Handle;
   if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
   with cursor as TIBCursor do
-    if isc_dsql_execute2(@Status[0], @tr, @Statement, 1, in_SQLDA, nil) <> 0 then
+  begin
+    if FStatementType = stExecProcedure then
+      out_SQLDA := SQLDA
+    else
+      out_SQLDA := nil;
+    if isc_dsql_execute2(@Status[0], @tr, @Statement, 1, in_SQLDA, out_SQLDA) <> 0 then
       CheckError('Execute', Status);
+  end;
 end;
 
 
@@ -722,12 +729,23 @@ var
   retcode : integer;
 begin
   with cursor as TIBCursor do
-    begin
-    retcode := isc_dsql_fetch(@Status[0], @Statement, 1, SQLDA);
+  begin
+    if FStatementType = stExecProcedure then
+      //it is not recommended fetch from non-select statement, i.e. statement which have no cursor
+      //starting from Firebird 2.5 it leads to error 'Invalid cursor reference'
+      if SQLDA^.SQLD = 0 then
+        retcode := 100 //no more rows to retrieve
+      else
+      begin
+        retcode := 0;
+        SQLDA^.SQLD := 0; //hack: mark after first fetch
+      end
+    else
+      retcode := isc_dsql_fetch(@Status[0], @Statement, 1, SQLDA);
     if (retcode <> 0) and (retcode <> 100) then
       CheckError('Fetch', Status);
-    end;
-  Result := (retcode <> 100);
+  end;
+  Result := (retcode = 0);
 end;
 
 procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -246,6 +246,7 @@ function TConnectionName.StrToStatementType(s : string) : TStatementType;
 begin
   S:=Lowercase(s);
   if s = 'show' then exit(stSelect);
+  if s = 'call' then exit(stExecProcedure);
   result := inherited StrToStatementType(s);
 end;
 
@@ -297,7 +298,7 @@ begin
       end;
     end;
 
-  HMySQL:=mysql_real_connect(HMySQL,PChar(H),PChar(U),Pchar(P),Nil,APort,Nil,0);
+  HMySQL:=mysql_real_connect(HMySQL,PChar(H),PChar(U),Pchar(P),Nil,APort,Nil,CLIENT_MULTI_RESULTS); //CLIENT_MULTI_RESULTS is required by CALL SQL statement(executes stored procedure), that produces result sets
   If (HMySQL=Nil) then
     MySQlError(Nil,SErrServerConnectFailed,Self);
 
@@ -476,7 +477,7 @@ begin
     FStatement:=Buf;
     if assigned(AParams) and (AParams.count > 0) then
       FStatement := AParams.ParseSQL(FStatement,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psSimulated,paramBinding,ParamReplaceString);
-    if FStatementType=stSelect then
+    if FStatementType in [stSelect,stExecProcedure] then
       FNeedData:=True;
     end
 end;
@@ -493,7 +494,7 @@ Var
 
 begin
   C:=Cursor as TCursorName;
-  if c.FStatementType=stSelect then
+  if c.FStatementType in [stSelect,stExecProcedure] then
     c.FNeedData:=False;
   If (C.FRes<>Nil) then
     begin
@@ -511,6 +512,7 @@ Var
   C : TCursorName;
   i : integer;
   ParamNames,ParamValues : array of string;
+  Res: PMYSQL_RES;
 
 begin
   C:=Cursor as TCursorName;
@@ -535,7 +537,14 @@ begin
       C.RowsAffected := mysql_affected_rows(FMYSQL);
       C.LastInsertID := mysql_insert_id(FMYSQL);
       if C.FNeedData then
-        C.FRes:=mysql_store_result(FMySQL);
+        repeat
+        Res:=mysql_store_result(FMySQL); //returns a null pointer if the statement didn't return a result set
+        if Res<>nil then
+          begin
+          mysql_free_result(C.FRes);
+          C.FRes:=Res;
+          end;
+        until mysql_next_result(FMySQL)<>0;
       end;
     end;
 end;
@@ -569,13 +578,10 @@ begin
         ADecimals:=AField^.decimals;
         if (ADecimals < 5) and (ASize-2-ADecimals < 15) then //ASize is display size i.e. with sign and decimal point
           NewType := ftBCD
-        else 
-          begin
-            if (ADecimals = 0) and (ASize < 20) then
-              NewType := ftLargeInt
-            else
-              NewType := ftFmtBCD;
-          end;
+        else if (ADecimals = 0) and (ASize < 20) then
+          NewType := ftLargeInt
+        else
+          NewType := ftFmtBCD;
         NewSize := ADecimals;
       end;
     FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:

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

@@ -1142,8 +1142,6 @@ begin
 
   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;

packages/fcl-db/tests/testfieldtypes.pas

@@ -60,6 +60,7 @@ type
     procedure TestInt;
     procedure TestScript;
     procedure TestInsertReturningQuery;
+    procedure TestOpenStoredProc;
 
     procedure TestTemporaryTable;
     procedure TestRefresh;
@@ -1185,6 +1186,46 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestOpenStoredProc;
+begin
+  with TSQLDBConnector(DBConnector) do
+  begin
+    if SQLDbType in MySQLdbTypes then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
+      Query.SQL.Text:='call FPDEV_PROC';
+    end
+    else if SQLDbType = interbase then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
+      Query.SQL.Text:='execute procedure FPDEV_PROC';
+    end
+    else
+    begin
+      Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
+      Exit;
+    end;
+    Transaction.CommitRetaining;
+
+    try
+      Query.Open;
+      AssertEquals(1, Query.Fields[0].AsInteger);
+      Query.Next;
+      if not(SQLDbType in [interbase]) then
+      begin
+        AssertFalse('Eof after 1st row', Query.Eof);
+        AssertEquals(2, Query.Fields[0].AsInteger);
+        Query.Next;
+      end;
+      AssertTrue('No Eof after last row', Query.Eof);
+      Query.Close;
+    finally
+      Connection.ExecuteDirect('drop procedure FPDEV_PROC');
+      Transaction.CommitRetaining;
+    end;
+  end;
+end;
+
 procedure TTestFieldTypes.TestClearUpdateableStatus;
 // Test if CanModify is correctly disabled in case of a select query without
 // a from-statement.
@@ -1364,13 +1405,13 @@ begin
                               ')                            ');
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
-    Query.ExecSQL;
     query.sql.Text:='select * from FPDEV2';
     Query.Open;
+    Query.InsertRecord([1,'test1']);
+    Query.ApplyUpdates;
+    Query.Close;
+    Query.Open;
     AssertEquals(query.FieldByName('NAME').AsString,'test1');
-    Query.insert;
-    query.fields[1].AsString:='11';
     query.Close;
     end;
 end;