Browse Source

--- Merging r19005 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r19006 into '.':
U packages/postgres/src/postgres3dyn.pp
U packages/postgres/src/postgres3.pp
--- Merging r19008 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r19039 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r19060 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r19214 into '.':
G packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r19215 into '.':
U packages/fcl-db/src/base/dsparams.inc
--- Merging r19219 into '.':
U packages/fcl-db/src/base/bufdataset.pas

# revisions: 19005,19006,19008,19039,19060,19214,19215,19219
------------------------------------------------------------------------
r19005 | marco | 2011-09-07 13:52:06 +0200 (Wed, 07 Sep 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Test for mapping numeric to bcd type fields, and a fix for issues in
ibconnection found with it, Mantis #20182

------------------------------------------------------------------------
------------------------------------------------------------------------
r19006 | marco | 2011-09-07 14:13:10 +0200 (Wed, 07 Sep 2011) | 2 lines
Changed paths:
M /trunk/packages/postgres/src/postgres3.pp
M /trunk/packages/postgres/src/postgres3dyn.pp

* postgres header support for PQdescribePrepared, part of mantis #20133

------------------------------------------------------------------------
------------------------------------------------------------------------
r19008 | marco | 2011-09-07 14:21:52 +0200 (Wed, 07 Sep 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* postgres part of sqldb returning support, fixes Mantis #20133
Patch by Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r19039 | marco | 2011-09-09 20:13:03 +0200 (Fri, 09 Sep 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* adds some checks to sqldb avoid AV and memleaks. Mantis #19326 and #18669

------------------------------------------------------------------------
------------------------------------------------------------------------
r19060 | marco | 2011-09-14 09:48:24 +0200 (Wed, 14 Sep 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* also quote ftguid fields. Mantis 20219.

------------------------------------------------------------------------
------------------------------------------------------------------------
r19214 | marco | 2011-09-24 22:19:39 +0200 (Sat, 24 Sep 2011) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

* Patch from Lacak2, mantis #18241 mapping "..with timezone" fields to their non timezone fields ft*'s.
No processing of timestamp is done.

------------------------------------------------------------------------
------------------------------------------------------------------------
r19215 | marco | 2011-09-24 22:24:55 +0200 (Sat, 24 Sep 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* fixes for > 100 query parameters. Mantis #19645, patch from Lacak2

------------------------------------------------------------------------
------------------------------------------------------------------------
r19219 | marco | 2011-09-24 23:22:18 +0200 (Sat, 24 Sep 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* use bcdcompare instead of overloaded operator. Mantis #19613, patch by Lacak2

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@19252 -

marco 14 years ago
parent
commit
4e22eebce9

+ 1 - 8
packages/fcl-db/src/base/bufdataset.pas

@@ -701,14 +701,7 @@ end;
 
 function DBCompareBCD(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 begin
-  // A simple subtraction doesn't work, since it could be that the result
-  // doesn't fit into a LargeInt
-  if PBCD(subValue)^ < PBCD(aValue)^ then
-    result := -1
-  else if PBCD(subValue)^  > PBCD(aValue)^ then
-    result := 1
-  else
-    result := 0;
+  result:=BCDCompare(PBCD(subValue)^, PBCD(aValue)^);
 end;
 
 procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;

+ 11 - 9
packages/fcl-db/src/base/dsparams.inc

@@ -356,10 +356,11 @@ begin
               end;
             if ParameterStyle in [psPostgreSQL,psSimulated] then
               begin
-              if ParameterIndex > 8 then
-                inc(NewQueryLength,2)
-              else
-                inc(NewQueryLength,1)
+              i:=ParameterIndex+1;
+              repeat
+                inc(NewQueryLength);
+                i:=i div 10;
+              until i=0;
               end;
 
             // store ParameterIndex in FParamIndex, ParamPart data
@@ -396,7 +397,10 @@ begin
       Move(SQL[BufIndex],NewQuery[NewQueryIndex],CopyLen);
       Inc(NewQueryIndex,CopyLen);
       case ParameterStyle of
-        psInterbase : NewQuery[NewQueryIndex]:='?';
+        psInterbase : begin
+                        NewQuery[NewQueryIndex]:='?';
+                        Inc(NewQueryIndex);
+                      end;
         psPostgreSQL,
         psSimulated : begin
                         ParamName := IntToStr(ParamBinding[i]+1);
@@ -405,15 +409,13 @@ begin
                           NewQuery[NewQueryIndex]:='$';
                           Inc(NewQueryIndex);
                           end;
-                        NewQuery[NewQueryIndex]:= paramname[1];
-                        if length(paramname)>1 then
+                        for b := 1 to length(ParamName) do
                           begin
+                          NewQuery[NewQueryIndex]:=ParamName[b];
                           Inc(NewQueryIndex);
-                          NewQuery[NewQueryIndex]:= paramname[2]
                           end;
                       end;
       end;
-      Inc(NewQueryIndex);
       BufIndex:=ParamPart[i].Stop;
     end;
     CopyLen:=Length(SQL)+1-BufIndex;

+ 3 - 5
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -437,14 +437,12 @@ end;
 procedure TIBConnection.TranslateFldType(SQLType, SQLSubType, SQLLen, SQLScale : integer;
            var TrType : TFieldType; var TrLen : word);
 begin
-  trlen := 0;
+  TrLen := 0;
   if SQLScale < 0 then
     begin
-    if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
-      begin
-      TrLen := abs(SQLScale);
+    TrLen := abs(SQLScale);
+    if (TrLen <= MaxBCDScale) then //Note: NUMERIC(18,3) or (17,2) must be mapped to ftFmtBCD, but we do not know Precision
       TrType := ftBCD
-      end
     else
       TrType := ftFMTBcd;
     end

+ 23 - 10
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -24,10 +24,10 @@ type
   TPQCursor = Class(TSQLCursor)
     protected
     Statement    : string;
+    StmtName     : string;
     tr           : TPQTrans;
     res          : PPGresult;
     CurTuple     : integer;
-    Nr           : string;
     FieldBinding : array of integer;
   end;
 
@@ -117,9 +117,11 @@ const Oid_Bool     = 16;
       Oid_Unknown  = 705;
       Oid_bpchar   = 1042;
       Oid_varchar  = 1043;
-      Oid_timestamp = 1114;
       oid_date      = 1082;
       oid_time      = 1083;
+      Oid_timeTZ    = 1266;
+      Oid_timestamp = 1114;
+      Oid_timestampTZ = 1184;
       oid_numeric   = 1700;
       Oid_uuid      = 2950;
 
@@ -411,9 +413,11 @@ begin
     Oid_int2               : Result := ftSmallInt;
     Oid_Float4             : Result := ftFloat;
     Oid_Float8             : Result := ftFloat;
-    Oid_TimeStamp          : Result := ftDateTime;
+    Oid_TimeStamp,
+    Oid_TimeStampTZ        : Result := ftDateTime;
     Oid_Date               : Result := ftDate;
-    Oid_Time               : Result := ftTime;
+    Oid_Time,
+    Oid_TimeTZ             : Result := ftTime;
     Oid_Bool               : Result := ftBoolean;
     Oid_Numeric            : begin
                              Result := ftBCD;
@@ -516,16 +520,16 @@ begin
   with (cursor as TPQCursor) do
     begin
     FPrepared := False;
-    nr := inttostr(FCursorcount);
-    inc(FCursorCount);
     // Prior to v8 there is no support for cursors and parameters.
     // So that's not supported.
     if FStatementType in [stInsert,stUpdate,stDelete, stSelect] then
       begin
+      StmtName := 'prepst'+inttostr(FCursorCount);
+      inc(FCursorCount);
       tr := TPQTrans(aTransaction.Handle);
       // Only available for pq 8.0, so don't use it...
       // Res := pqprepare(tr,'prepst'+name+nr,pchar(buf),params.Count,pchar(''));
-      s := 'prepare prepst'+nr+' ';
+      s := 'prepare '+StmtName+' ';
       if Assigned(AParams) and (AParams.count > 0) then
         begin
         s := s + '(';
@@ -548,6 +552,15 @@ begin
         pqclear(res);
         DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
         end;
+      // if statement is INSERT, UPDATE, DELETE with RETURNING clause, then
+      // override the statement type derrived by parsing the query.
+      if (FStatementType in [stInsert,stUpdate,stDelete]) and (pos('RETURNING', upcase(s)) > 0) then
+        begin
+        PQclear(res);
+        res := PQdescribePrepared(tr.PGConn,pchar(StmtName));
+        if (PQresultStatus(res) = PGRES_COMMAND_OK) and (PQnfields(res) > 0) then
+          FStatementType := stSelect;
+        end;
       FPrepared := True;
       end
     else
@@ -563,7 +576,7 @@ begin
     if not tr.ErrorOccured then
       begin
       PQclear(res);
-      res := pqexec(tr.PGConn,pchar('deallocate prepst'+nr));
+      res := pqexec(tr.PGConn,pchar('deallocate '+StmtName));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
           pqclear(res);
@@ -630,12 +643,12 @@ begin
           end
         else
           FreeAndNil(ar[i]);
-        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),Aparams.count,@Ar[0],@Lengths[0],@Formats[0],1);
+        res := PQexecPrepared(tr.PGConn,pchar(StmtName),Aparams.count,@Ar[0],@Lengths[0],@Formats[0],1);
         for i := 0 to AParams.count -1 do
           FreeMem(ar[i]);
         end
       else
-        res := PQexecPrepared(tr.PGConn,pchar('prepst'+nr),0,nil,nil,nil,1);
+        res := PQexecPrepared(tr.PGConn,pchar(StmtName),0,nil,nil,nil,1);
       end
     else
       begin

+ 3 - 2
packages/fcl-db/src/sqldb/sqldb.pp

@@ -716,6 +716,7 @@ function TSQLConnection.GetAsSQLText(Param: TParam) : string;
 begin
   if (not assigned(param)) or param.IsNull then Result := 'Null'
   else case param.DataType of
+    ftGuid,
     ftMemo,
     ftFixedChar,
     ftString   : Result := QuotedStr(Param.AsString);
@@ -1200,11 +1201,11 @@ begin
 
   try
     FieldDefs.Clear;
-
+    if not Assigned(Database) then DatabaseError(SErrDatabasenAssigned);
     TSQLConnection(Database).AddFieldDefs(fcursor,FieldDefs);
   finally
     FLoadingFieldDefs := False;
-    FCursor.FInitFieldDef := false;
+    if Assigned(FCursor) then FCursor.FInitFieldDef := false;
   end;
 end;
 

+ 48 - 13
packages/fcl-db/tests/testfieldtypes.pas

@@ -266,27 +266,62 @@ procedure TTestFieldTypes.TestNumeric;
 const
   testValuesCount = 13;
   testValues : Array[0..testValuesCount-1] of currency = (-123456.789,-10200,-10000,-1875.25,-10,-0.5,0,0.5,10,1875.25,10000,10200,123456.789);
+  Sizes: array [0..4] of integer = (4,0,3,5,0); //scale
 
 var
   i          : byte;
+  s          : string;
 
 begin
-  CreateTableWithFieldType(ftBCD,'NUMERIC(10,4)');
-  TestFieldDeclaration(ftBCD,sizeof(Currency));
-
-  for i := 0 to testValuesCount-1 do
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + CurrToStrF(testValues[i],ffFixed,3,DBConnector.FormatSettings) + ')');
+  with TSQLDBConnector(DBConnector) do begin
+    if SQLDbType = INTERBASE then
+      s := '' //Interbase supports precision up to 18 only
+    else
+      s := ', N4 NUMERIC(19,0)';
+    Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N1 NUMERIC(18,0), N2 NUMERIC(18,3), N3 NUMERIC(18,5)' + s + ')');
+    Transaction.CommitRetaining;
 
-  with TSQLDBConnector(DBConnector).Query do
+    with Query do
     begin
-    Open;
+      SQL.Text := 'select * from FPDEV2';
+      Open;
+
+      AssertEquals(sizeof(Currency), Fields[0].DataSize);
+      AssertTrue(Fields[0].DataType=ftBCD);
+      AssertEquals(Sizes[0], Fields[0].Size);
+
+      AssertTrue(Fields[1].DataType in [ftFmtBCD, ftLargeInt]);
+      AssertEquals(Sizes[1], Fields[1].Size);
+
+      for i := 2 to FieldCount-1 do
+      begin
+        AssertEquals(sizeof(TBCD), Fields[i].DataSize);
+        AssertTrue(Fields[i].DataType=ftFmtBCD);
+        AssertEquals(Sizes[i], Fields[i].Size);
+      end;
+
+      Close;
+    end;
+
     for i := 0 to testValuesCount-1 do
+    begin
+      s :=CurrToStrF(testValues[i],ffFixed,3,DBConnector.FormatSettings);
+      Connection.ExecuteDirect(format('insert into FPDEV2 (FT,N2,N3) values (%s,%s,%s)', [s,s,s]));
+    end;
+
+    with Query do
+    begin
+      Open;
+      for i := 0 to testValuesCount-1 do
       begin
-      AssertEquals(testValues[i],fields[0].AsCurrency);
-      Next;
+        AssertEquals(testValues[i], Fields[0].AsCurrency);
+        AssertEquals(testValues[i], Fields[2].AsCurrency);
+        AssertEquals(testValues[i], Fields[3].AsCurrency);
+        Next;
       end;
-    close;
+      Close;
     end;
+  end;
 end;
 
 
@@ -1136,15 +1171,15 @@ end;
 
 procedure TTestFieldTypes.TestInsertReturningQuery;
 begin
-  if (SQLDbType <> interbase) then Ignore('This test does only apply to Firebird.');
+  if not(SQLDbType in [postgresql,interbase,oracle]) then Ignore('This test does not apply to this db-engine');
   with TSQLDBConnector(DBConnector) do
     begin
     // This only works with databases that supports 'insert into .. returning'
-    // for example, Firebird version 2.0 and up
+    // for example: PostgreSQL, Oracle, 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);
+    AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
     AssertEquals(154,Query.fields[0].AsInteger);
     Query.Close;
     end;

+ 1 - 0
packages/postgres/src/postgres3.pp

@@ -123,6 +123,7 @@ const
 
   function PQexecPrepared(conn:PPGconn; stmtName:Pchar; nParams:longint; paramValues:PPchar; paramLengths:Plongint;
              paramFormats:Plongint; resultFormat:longint):PPGresult;cdecl;external External_library name 'PQexecPrepared';
+  function PQdescribePrepared(conn:PPGconn; stmtName:Pchar):PPGresult;cdecl;external External_library name 'PQdescribePrepared';
 
   { Interface for multiple-result or asynchronous queries  }
   function PQsendQuery(conn:PPGconn; query:Pchar):longint;cdecl;external External_library name 'PQsendQuery';

+ 2 - 0
packages/postgres/src/postgres3dyn.pp

@@ -98,6 +98,7 @@ var
   PQexecParams : function (conn:PPGconn; command:Pchar; nParams:longint; paramTypes:POid; paramValues:PPchar;paramLengths:Plongint; paramFormats:Plongint; resultFormat:longint):PPGresult;cdecl;
   PQexecPrepared : function (conn:PPGconn; stmtName:Pchar; nParams:longint; paramValues:PPchar; paramLengths:Plongint;paramFormats:Plongint; resultFormat:longint):PPGresult;cdecl;
   PQPrepare : function (conn:PPGconn; stmtName:Pchar; query:Pchar; nParams:longint; paramTypes:POid):PPGresult;cdecl;
+  PQdescribePrepared : function (conn:PPGconn; stmtName:Pchar):PPGresult;cdecl;
 { Interface for multiple-result or asynchronous queries  }
   PQsendQuery : function (conn:PPGconn; query:Pchar):longint;cdecl;
   PQsendQueryParams : function (conn:PPGconn; command:Pchar; nParams:longint; paramTypes:POid; paramValues:PPchar;paramLengths:Plongint; paramFormats:Plongint; resultFormat:longint):longint;cdecl;
@@ -279,6 +280,7 @@ begin
     pointer(PQexecParams) := GetProcedureAddress(Postgres3LibraryHandle,'PQexecParams');
     pointer(PQexecPrepared) := GetProcedureAddress(Postgres3LibraryHandle,'PQexecPrepared');
     pointer(PQPrepare) := GetProcedureAddress(Postgres3LibraryHandle,'PQprepare');
+    pointer(PQdescribePrepared) := GetProcedureAddress(Postgres3LibraryHandle,'PQdescribePrepared');
     pointer(PQsendQuery) := GetProcedureAddress(Postgres3LibraryHandle,'PQsendQuery');
     pointer(PQsendQueryParams) := GetProcedureAddress(Postgres3LibraryHandle,'PQsendQueryParams');
     pointer(PQsendQueryPrepared) := GetProcedureAddress(Postgres3LibraryHandle,'PQsendQueryPrepared');