Merged revisions 11090,11094,11096,11098,11103-11104,11106,11108-11109,11111,11114,11117-11118,11122,11124,11126,11128-11129 via svnmerge from

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

........
  r11090 | joost | 2008-05-26 23:38:08 +0200 (Mon, 26 May 2008) | 2 lines
  
   * Raise exception if TFieldDef with existing name is added to TFieldDefs + test
   * Allow double field-names in select queries + test (bugs 8457+10819)
........
  r11118 | joost | 2008-05-29 11:08:12 +0200 (Thu, 29 May 2008) | 1 line
  
   * Patch from Joao Morais to fix the reading of a bytea field from a PgSQL database
........
  r11128 | joost | 2008-05-29 20:52:18 +0200 (Thu, 29 May 2008) | 1 line
  
   * Patch from Joao Morais to fix the storage of floating point, time and timestamp fields on a PgSQL database
........
  r11129 | joost | 2008-05-29 21:02:23 +0200 (Thu, 29 May 2008) | 5 lines
  
   * Patch from Paul Ishenin to fix several Delphi-incompatilibities:
    - Make TField.SetDataset virtual
    - Pass SetVariant argument as const
    - Add TField.Lookup property
    - Add TDataset.SetDefaultsField protected method
........

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

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

@@ -218,6 +218,7 @@ type
 //    procedure Clear;
 //    procedure Delete(Index: Longint);
     procedure Update; overload;
+    Function MakeNameUnique(const AName : String) : string; virtual;
     Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
     property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
   end;
@@ -256,8 +257,8 @@ type
   { TField }
 
   TField = class(TComponent)
-  Private
-    FAlignMent : TAlignment;
+  private
+    FAlignment : TAlignment;
     FAttributeSet : String;
     FCalculated : Boolean;
     FConstraintErrorMessage : String;
@@ -295,16 +296,17 @@ type
     FValidating : Boolean;
     FVisible : Boolean;
     FProviderFlags : TProviderFlags;
-    Function GetIndex : longint;
+    function GetIndex : longint;
+    function GetLookup: Boolean;
     procedure SetAlignment(const AValue: TAlignMent);
     procedure SetIndex(const AValue: Integer);
-    Procedure SetDataset(AValue : TDataset);
     function GetDisplayText: String;
     function GetEditText: String;
     procedure SetEditText(const AValue: string);
     procedure SetDisplayLabel(const AValue: string);
     procedure SetDisplayWidth(const AValue: Longint);
     function GetDisplayWidth: integer;
+    procedure SetLookup(const AValue: Boolean);
     procedure SetReadOnly(const AValue: Boolean);
     procedure SetVisible(const AValue: Boolean);
     function IsDisplayStored : Boolean;
@@ -349,9 +351,10 @@ type
     procedure SetAsLongint(AValue: Longint); virtual;
     procedure SetAsInteger(AValue: Integer); virtual;
     procedure SetAsLargeint(AValue: Largeint); virtual;
-    procedure SetAsVariant(AValue: variant); virtual;
+    procedure SetAsVariant(const AValue: variant); virtual;
     procedure SetAsString(const AValue: string); virtual;
     procedure SetAsWideString(const aValue: WideString); virtual;
+    procedure SetDataset(AValue : TDataset); virtual;
     procedure SetDataType(AValue: TFieldType);
     procedure SetNewValue(const AValue: Variant);
     procedure SetSize(AValue: Word); virtual;
@@ -405,7 +408,7 @@ type
     property OldValue: variant read GetOldValue;
     property LookupList: TLookupList read GetLookupList;
   published
-    property AlignMent : TAlignMent Read FAlignMent write SetAlignment default taLeftJustify;
+    property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
     property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
@@ -416,11 +419,12 @@ type
     property HasConstraints: Boolean read FHasConstraints;
     property Index: Longint read GetIndex write SetIndex;
     property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
+    property KeyFields: string read FKeyFields write FKeyFields;
+    property Lookup: Boolean read GetLookup write SetLookup;
+    property LookupCache: Boolean read FLookupCache write FLookupCache;
     property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
     property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
     property LookupResultField: string read FLookupResultField write FLookupResultField;
-    property KeyFields: string read FKeyFields write FKeyFields;
-    property LookupCache: Boolean read FLookupCache write FLookupCache;
     property Origin: string read FOrigin write FOrigin;
     property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
@@ -1202,6 +1206,7 @@ type
     procedure SetBufListSize(Value: Longint); virtual;
     procedure SetChildOrder(Component: TComponent; Order: Longint); override;
     procedure SetCurrentRecord(Index: Longint); virtual;
+    procedure SetDefaultFields(const Value: Boolean);
     procedure SetFiltered(Value: Boolean); virtual;
     procedure SetFilterOptions(Value: TFilterOptions); virtual;
     procedure SetFilterText(const Value: string); virtual;
@@ -2011,12 +2016,15 @@ begin
 end;
 
 procedure TNamedItem.SetDisplayName(const AValue: string);
+Var TmpInd : Integer;
 begin
   if FName=AValue then exit;
-  if (AValue <> '') and
-     (Collection is TOwnedCollection) and
-     (TFieldDefs(Collection).IndexOf(AValue) >= 0) then
-     DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
+  if (AValue <> '') and (Collection is TFieldDefs) then
+    begin
+    TmpInd :=  (TDefCollection(Collection).IndexOf(AValue));
+    if (TmpInd >= 0) and (TmpInd <> Index) then
+      DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
+    end;
   FName:=AValue;
   inherited SetDisplayName(AValue);
 end;

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

@@ -660,7 +660,7 @@ begin
       begin
       TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
         TransType, TransLen);
-      FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
+      FD := TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(SQLDA^.SQLVar[x].AliasName), TransType,
          TransLen, False, (x + 1));
       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
 //      FD.DisplayName := SQLDA^.SQLVar[x].AliasName;

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

@@ -546,7 +546,7 @@ begin
 
     if MySQLDataType(field^.ftype, field^.length, field^.decimals, DFT, DFS) then
       begin
-      TFieldDef.Create(FieldDefs, field^.name, DFT, DFS, False, TF);
+      TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(field^.name), DFT, DFS, False, TF);
       c.MapDSRowToMSQLRow[TF-1] := I;
       inc(TF);
       end

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

@@ -103,6 +103,7 @@ ResourceString
   SErrPrepareFailed = 'Preparation of query failed.';
 
 const Oid_Bool     = 16;
+      Oid_Bytea    = 17;
       Oid_Text     = 25;
       Oid_Oid      = 26;
       Oid_Name     = 19;
@@ -395,6 +396,7 @@ begin
                              end;
 //    Oid_text               : Result := ftstring;
     Oid_text               : Result := ftBlob;
+    Oid_Bytea              : Result := ftBlob;
     Oid_oid                : Result := ftInteger;
     Oid_int8               : Result := ftLargeInt;
     Oid_int4               : Result := ftInteger;
@@ -566,10 +568,16 @@ begin
         for i := 0 to AParams.count -1 do if not AParams[i].IsNull then
           begin
           case AParams[i].DataType of
-            ftdatetime : s := formatdatetime('YYYY-MM-DD',AParams[i].AsDateTime);
-            ftdate     : s := formatdatetime('YYYY-MM-DD',AParams[i].AsDateTime);
-          else
-            s := AParams[i].asstring;
+            ftDateTime:
+              s := FormatDateTime('yyyy-mm-dd hh:nn:ss', AParams[i].AsDateTime);
+            ftDate:
+              s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime);
+            ftTime:
+              s := FormatDateTime('hh:nn:ss', AParams[i].AsDateTime);
+            ftFloat, ftCurrency:
+              Str(AParams[i].AsFloat, s);
+            else
+              s := AParams[i].AsString;
           end; {case}
           GetMem(ar[i],length(s)+1);
           StrMove(PChar(ar[i]),Pchar(s),Length(S)+1);
@@ -632,7 +640,7 @@ begin
     for i := 0 to nFields-1 do
       begin
       fieldtype := TranslateFldType(Res, i,size);
-      with TFieldDef.Create(FieldDefs, PQfname(Res, i), fieldtype,size, False, (i + 1)) do
+      with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(PQfname(Res, i)), fieldtype,size, False, (i + 1)) do
         FieldBinding[FieldNo-1] := i;
       end;
     CurTuple := -1;

packages/fcl-db/tests/testbasics.pas

@@ -20,6 +20,7 @@ type
   published
     procedure TestParseSQL;
     procedure TestInitFielddefsFromFields;
+    procedure TestDoubleFieldDef;
   end;
 
 implementation
@@ -143,6 +144,23 @@ begin
   CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
 end;
 
+procedure TTestBasics.TestDoubleFieldDef;
+var ds : TDataset;
+    PassException : boolean;
+begin
+  // If a second field with the same name is added to a TFieldDefs, an exception
+  // should occur
+  ds := TDataset.create(nil);
+  ds.FieldDefs.Add('Field1',ftInteger);
+  PassException:=False;
+  try
+    ds.FieldDefs.Add('Field1',ftString,10,false)
+  except
+    on E: EDatabaseError do PassException := True;
+  end;
+  AssertTrue(PassException);
+end;
+
 initialization
   RegisterTest(TTestBasics);
 end.

packages/fcl-db/tests/testfieldtypes.pas

@@ -30,6 +30,7 @@ type
     procedure TestClearUpdateableStatus;
     procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
+    procedure TestDoubleFieldNames; // bug 8457
     procedure TestParseUnion; // bug 8442
     procedure TestInsertLargeStrFields; // bug 9600
     procedure TestNumericNames; // Bug9661
@@ -1006,6 +1007,28 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestDoubleFieldNames;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    with query do
+      begin
+      SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
+      Open;
+      AssertTrue(assigned(FindField('ID')));
+      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);
+      AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
+      close;
+      end;
+    end;
+end;
+
 procedure TTestFieldTypes.TestParseUnion;
 begin
   with TSQLDBConnector(DBConnector) do