Merged revisions 11629,11664-11667,11670,11683,11685,11689-11692,11694-11696,11698,11701-11702,11705-11707,11712-11718,11723-11726,11728-11729,11733-11737,11778,11780-11781,11785,11810,11822,11831,11836,11848,11872,11876-11878,11881-11883,11889,11891-11895,11899-11902,11920-11925,11931-11932,11935,11938,11941,11986,11992,12014,12018,12041-12042,12044,12046,12051-12053,12055,12058,12063,12067-12072,12074,12076,12079-12081,12083-12084,12086,12089-12091,12095-12098,12100-12105,12111-12113,12115-12116,12123-12124,12126-12127,12132-12137,12139-12140,12144-12151,12161,12164-12165,12172,12177-12195,12197,12206-12212,12236,12240,12243-12244,12246-12252,12256,12259,12263-12265,12267,12270-12271,12273,12275,12280-12282,12287-12289 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r11629 | joost | 2008-08-22 14:49:29 +0200 (Fri, 22 Aug 2008) | 1 line
  
   * Fixed fixed-width char-parameters + test
........
  r12211 | joost | 2008-11-23 12:02:13 +0100 (Sun, 23 Nov 2008) | 1 line
  
   * Implemented TBufDataset.BookmarkValid
........
  r12240 | joost | 2008-11-27 11:18:55 +0100 (Thu, 27 Nov 2008) | 1 line
  
   * Fixed ftBCD support, partly bug #12143. Note that a TParam with a datatype of ftBCD in practice never occurs
........
  r12243 | joost | 2008-11-27 12:40:18 +0100 (Thu, 27 Nov 2008) | 1 line
  
   * Removed empty implementation of TBlobField.Assign(to), uses inherited implementation. Bug #12578
........
  r12244 | joost | 2008-11-27 12:51:24 +0100 (Thu, 27 Nov 2008) | 1 line
  
   * UsePrimaryKeyAsKey default value is true, bug #12257
........
  r12256 | joost | 2008-11-27 22:14:36 +0100 (Thu, 27 Nov 2008) | 1 line
  
   * Also collect parameter fieldnames when master dataset is inactive, patch from Jesus Reyes, bug #12129
........
  r12280 | joost | 2008-11-29 23:43:54 +0100 (Sat, 29 Nov 2008) | 1 line
  
   * Fix for two columns with the same name
........
  r12287 | joost | 2008-12-02 13:33:27 +0100 (Tue, 02 Dec 2008) | 1 line
  
   * Fixed oracle-cursor leak
........
  r12288 | joost | 2008-12-02 13:57:17 +0100 (Tue, 02 Dec 2008) | 1 line
  
   * Improved error-handling
........
  r12289 | joost | 2008-12-02 14:30:33 +0100 (Tue, 02 Dec 2008) | 1 line
  
   * Use DynLibs.Sharedsuffix for postgres,sqlite and odbc
........

git-svn-id: branches/fixes_2_2@12296 -

packages/fcl-db/src/base/bufdataset.pas

@@ -144,6 +144,7 @@ type
     procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark);  virtual; abstract;
     procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
+    function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
 
     procedure InitialiseIndex; virtual; abstract;
 
@@ -467,6 +468,7 @@ type
     procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
+    function BookmarkValid(ABookmark: TBookmark): Boolean; override;
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
 
     property ChangeCount : Integer read GetChangeCount;
@@ -1041,6 +1043,11 @@ begin
   FDataset := ADataset;
 end;
 
+function TBufIndex.BookmarkValid(const ABookmark: PBufBookmark): boolean;
+begin
+  Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
+end;
+
 function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
 begin
   result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData);
@@ -2421,6 +2428,11 @@ begin
   CreateFields;
 end;
 
+function TBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
+begin
+  Result:=FCurrentIndex.BookmarkValid(ABookmark);
+end;
+
 function TBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
   ): Longint;
 begin

packages/fcl-db/src/base/db.pas

@@ -794,7 +794,6 @@ type
     FTransliterate : Boolean;
     Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
   protected
-    procedure AssignTo(Dest: TPersistent); override;
     procedure FreeBuffers; override;
     function GetAsString: string; override;
     function GetAsVariant: Variant; override;
@@ -808,7 +807,6 @@ type
     procedure SetAsWideString(const aValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
-    procedure Assign(Source: TPersistent); override;
     procedure Clear; override;
     class function IsBlob: Boolean; override;
     procedure LoadFromFile(const FileName: string);

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

@@ -796,7 +796,14 @@ begin
             inc(CurrBuff,2);
             end
           else
+            begin
+            // The buffer-length is always VSQLVar^.sqllen, nothing more, nothing less
+            // so fill the complete buffer with valid data. Adding #0 will lead
+            // to problems, because the #0 will be seen as a part of the (binary) string
             CurrBuff := VSQLVar^.SQLData;
+            w := VSQLVar^.sqllen;
+            s := PadRight(s,w);
+            end;
           Move(s[1], CurrBuff^, w);
           end;
         SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP :

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

@@ -16,6 +16,11 @@ uses
   oratypes;
 
 type
+  EOraDatabaseError = class(EDatabaseError)
+    public
+      ORAErrorCode : Longint;
+  end;
+
   TOracleTrans = Class(TSQLHandle)
     protected
   end;
@@ -92,10 +97,18 @@ procedure TOracleConnection.HandleError;
 
 var errcode : sb4;
     buf     : array[0..1023] of char;
+    E       : EOraDatabaseError;
 
 begin
-  OCIErrorGet(FOciError,1,nil,errcode,@buf[1],1023,OCI_HTYPE_ERROR);
-  DatabaseErrorFmt(SErrOracle+LineEnding+buf,[inttostr(errcode)],self);
+  OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
+
+  if (Self.Name <> '') then
+    E := EOraDatabaseError.CreateFmt('%s : %s',[Self.Name,buf])
+  else
+    E := EOraDatabaseError.Create(buf);
+
+  E.ORAErrorCode := errcode;
+  Raise E;
 end;
 
 procedure TOracleConnection.DoInternalConnect;
@@ -156,7 +169,7 @@ var tel : word;
 begin
   with cursor as TOracleCursor do
     begin
-    OCIHandleFree(FOciStmt,OCI_HTYPE_ERROR);
+    OCIHandleFree(FOciStmt,OCI_HTYPE_STMT);
     if Length(FieldBuffers) > 0 then
       for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
     end;

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

@@ -298,7 +298,7 @@ type
     property DeleteSQL : TStringlist read FDeleteSQL;
     property Params : TParams read FParams write FParams;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
-    property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
+    property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property StatementType : TStatementType read GetStatementType;
     property ParseSQL : Boolean read FParseSQL write SetParseSQL default true;
     Property DataSource : TDatasource Read GetDataSource Write SetDatasource;

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

@@ -170,10 +170,7 @@ begin
         ftsmallint: checkerror(sqlite3_bind_int(fstatement,I,p.asinteger));
         ftword:     checkerror(sqlite3_bind_int(fstatement,I,P.asword));
         ftlargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.aslargeint));
-        ftbcd: begin
-               cu1:= P.ascurrency;
-               checkerror(sqlite3_bind_int64(fstatement,I,pint64(@cu1)^));
-               end;
+        ftbcd,
         ftfloat,
         ftcurrency,
         ftdatetime,
@@ -391,7 +388,7 @@ begin
                 end;
       ftUnknown : DatabaseError('Unknown record type: '+FN);
     end; // Case
-    tfielddef.create(fielddefs,FN,ft1,size1,false,i+1);
+    tfielddef.create(fielddefs,FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
     end;
 end;
 
@@ -482,7 +479,7 @@ var
  str1: string;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
- 
+
 begin
   st:=TSQLite3Cursor(cursor).fstatement;
   fnum:= FieldDef.fieldno - 1;
@@ -496,8 +493,8 @@ begin
     ftSmallInt : psmallint(buffer)^ := sqlite3_column_int(st,fnum);
     ftWord     : pword(buffer)^     := sqlite3_column_int(st,fnum);
     ftBoolean  : pwordbool(buffer)^ := sqlite3_column_int(st,fnum)<>0;
-    ftLargeInt,
-    ftBCD      : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
+    ftLargeInt : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
+    ftBCD      : PCurrency(buffer)^:= FloattoCurr(sqlite3_column_double(st,fnum));
     ftFloat,
     ftCurrency : pdouble(buffer)^:= sqlite3_column_double(st,fnum);
     ftDateTime,

packages/fcl-db/tests/testfieldtypes.pas

@@ -28,6 +28,7 @@ type
     procedure RunTest; override;
   published
     procedure TestClearUpdateableStatus;
+    procedure TestFixedStringParamQuery;
     procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
     procedure TestDoubleFieldNames; // bug 8457
@@ -700,6 +701,11 @@ begin
   TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
 end;
 
+procedure TTestFieldTypes.TestFixedStringParamQuery;
+begin
+  TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
+end;
+
 procedure TTestFieldTypes.TestDateParamQuery;
 
 begin
@@ -731,6 +737,7 @@ begin
       case ADataType of
         ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
         ftFloat  : Params.ParamByName('field1').AsFloat   := testFloatValues[i];
+        ftFixedChar,
         ftString : Params.ParamByName('field1').AsString  := testStringValues[i];
         ftDate   : if cross then
                      Params.ParamByName('field1').AsString:= testDateValues[i]
@@ -753,7 +760,13 @@ begin
       case ADataType of
         ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
         ftFloat  : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
-        ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
+        ftFixedChar,
+        ftString : begin
+                   if FieldByName('FIELD1').isnull then
+                     AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString)
+                   else
+                     AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
+                   end;
         ftdate   : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime));
       else
         AssertTrue('no test for paramtype available',False);

packages/fcl-db/tests/toolsunit.pas

@@ -231,6 +231,7 @@ var DBConnectorClass : TPersistentClass;
     i                : integer;
 begin
   testValues[ftString] := testStringValues;
+  testValues[ftFixedChar] := testStringValues;
   testValues[ftDate] := testDateValues;
   for i := 0 to testValuesCount-1 do
     begin

packages/odbc/src/odbcsql.inc

@@ -22,16 +22,14 @@
 interface
 
 uses
-{$IFDEF DYNLOADINGODBC}
      Dynlibs,
-{$ENDIF}
      ctypes,
      sysutils;
 
 {$IFDEF Unix}
   {$DEFINE extdecl:=cdecl}
   const
-    odbclib = 'libodbc.so';
+    odbclib = 'libodbc.'+sharedsuffix;
 {$ENDIF}
 {$IFDEF Windows}
   {$DEFINE extdecl:=stdcall}

packages/postgres/src/postgres3dyn.pp

@@ -12,11 +12,11 @@ unit postgres3dyn;
 interface
 
 uses
-  dynlibs, SysUtils, dllistdyn;
+  dynlibs, SysUtils, dllistdyn, ctypes;
 
 {$IFDEF Unix}
   const
-    pqlib = 'libpq.so';
+    pqlib = 'libpq.'+sharedsuffix;
 {$ENDIF}
 {$IFDEF Win32}
   const

packages/sqlite/src/sqlite3.inc

@@ -7,9 +7,11 @@
 
 interface
 
+uses
 {$ifdef LOAD_DYNAMICALLY}
-uses 
   SysUtils, DynLibs;
+{$else}
+  DynLibs;
 {$endif}
 
 {
@@ -28,7 +30,7 @@ const
 {$IFDEF WINDOWS}
   Sqlite3Lib = 'sqlite3.dll';
 {$else}
-  Sqlite3Lib = 'libsqlite3.so';
+  Sqlite3Lib = 'libsqlite3.'+sharedsuffix;
 {$endif}
 
   SQLITE_INTEGER = 1;