From 00e76eab6af4f4767eabc0f7715606ede5995ed7 Mon Sep 17 00:00:00 2001 From: joost Date: Mon, 29 Dec 2008 13:17:34 +0000 Subject: [PATCH] * 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 - --- .../src/sqldb/interbase/ibconnection.pp | 21 ++++++++++- packages/fcl-db/src/sqldb/sqldb.pp | 10 +++--- packages/fcl-db/tests/testfieldtypes.pas | 35 ++++++++++++++----- 3 files changed, 52 insertions(+), 14 deletions(-) diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp index 03f025753d..6da851440d 100644 --- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp +++ b/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); diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 26c5a9b198..84ef675da8 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/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 diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index 142e14c0e6..417c132a78 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/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;