* Applied patch from Luiz Americo with some optimizations. (Bug ID 25745)

git-svn-id: trunk@26800 -

packages/fcl-db/src/base/fields.inc

@@ -3323,19 +3323,19 @@ end;
 
 procedure TFields.CheckFieldNames(const Value: String);
 
+var
+  N: String;
+  StrPos: Integer;
 
-Var I : longint;
-    S,T : String;
-begin
-  T:=Value;
-  Repeat
-    I:=Pos(';',T);
-    If I=0 Then I:=Length(T)+1;
-    S:=Copy(T,1,I-1);
-    Delete(T,1,I);
+begin
+  if Value = '' then
+    Exit;
+  StrPos := 1;
+  repeat
+    N := ExtractFieldName(Value, StrPos);
     // Will raise an error if no such field...
-    FieldByName(S);
-  Until (T='');
+    FieldByName(N);
+  until StrPos > Length(Value);
 end;
 
 procedure TFields.Clear;
@@ -3358,17 +3358,19 @@ Var S : String;
     I : longint;
 
 begin
-  Result:=Nil;
   S:=UpperCase(Value);
   For I:=0 To FFieldList.Count-1 do
-    If S=UpperCase(TField(FFieldList[i]).FieldName) Then
-      Begin
+  begin
+    Result:=TField(FFieldList[I]);
+    if S=UpperCase(Result.FieldName) then
+    begin
       {$ifdef dsdebug}
       Writeln ('Found field ',Value);
       {$endif}
-      Result:=TField(FFieldList[I]);
       Exit;
-      end;
+    end;
+  end;
+  Result:=Nil;
 end;
 
 function TFields.FieldByName(const Value: String): TField;
@@ -3384,13 +3386,13 @@ function TFields.FieldByNumber(FieldNo: Integer): TField;
 Var i : Longint;
 
 begin
-  Result:=Nil;
   For I:=0 to FFieldList.Count-1 do
-    If FieldNo=TField(FFieldList[I]).FieldNo then
-      begin
-      Result:=TField(FFieldList[i]);
+  begin
+    Result:=TField(FFieldList[I]);
+    if FieldNo=Result.FieldNo then
       Exit;
-      end;
+  end;
+  Result:=Nil;
 end;
 
 function TFields.GetEnumerator: TFieldsEnumerator;

packages/fcl-db/tests/testbasics.pas

@@ -8,7 +8,7 @@ interface
 
 uses
   fpcunit, testutils, testregistry, testdecorator,
-  Classes, SysUtils;
+  Classes, SysUtils, db;
 
 type
 
@@ -16,6 +16,7 @@ type
 
   TTestBasics = class(TTestCase)
   private
+    function CreateDatasetWith3Fields: TDataset;
   protected
   published
     procedure TestParseSQL;
@@ -25,16 +26,36 @@ type
     procedure TestGetParamList;
     procedure TestGetFieldList;
     procedure TestExtractFieldName; //move record then copy. Is copy identical? Has record position changed?
+    procedure TestCheckFieldNames;
+    procedure TestFindField;
   end;
 
 implementation
 
-uses db, toolsunit;
+uses toolsunit;
 
 Type HackedDataset = class(TDataset);
 
 { TTestBasics }
 
+function TTestBasics.CreateDatasetWith3Fields: TDataset;
+var
+  F: TField;
+begin
+  Result := TDataSet.Create(nil);
+  F := TIntegerField.Create(Result);
+  F.FieldName := 'Field1';
+  F.DataSet := Result;
+
+  F := TIntegerField.Create(Result);
+  F.FieldName := 'Field2';
+  F.DataSet := Result;
+
+  F := TIntegerField.Create(Result);
+  F.FieldName := 'Field3';
+  F.DataSet := Result;
+end;
+
 procedure TTestBasics.TestParseSQL;
 var Params  : TParams;
     ReplStr : string;
@@ -214,24 +235,11 @@ end;
 procedure TTestBasics.TestGetFieldList;
 var
   ds: TDataSet;
-  F: TField;
   List: TList;
   ExceptionRaised: Boolean;
 begin
-  ds := TDataSet.Create(nil);
+  ds := CreateDatasetWith3Fields;
   try
-    F := TIntegerField.Create(ds);
-    F.FieldName := 'Field1';
-    F.DataSet := ds;
-
-    F := TIntegerField.Create(ds);
-    F.FieldName := 'Field2';
-    F.DataSet := ds;
-
-    F := TIntegerField.Create(ds);
-    F.FieldName := 'Field3';
-    F.DataSet := ds;
-
     List := TList.Create;
     try
       //should not
@@ -376,6 +384,61 @@ begin
   AssertEquals('xxx', FieldName);
 end;
 
+procedure TTestBasics.TestCheckFieldNames;
+var
+  ds: TDataSet;
+  ExceptionRaised: Boolean;
+begin
+  ds := CreateDatasetWith3Fields;
+  try
+    ExceptionRaised := False;
+    try
+      ds.Fields.CheckFieldNames('');
+    except
+      ExceptionRaised := True;
+    end;
+    AssertFalse(ExceptionRaised);
+
+    ExceptionRaised := False;
+    try
+      ds.Fields.CheckFieldNames('Field1;Field2');
+    except
+      ExceptionRaised := True;
+    end;
+    AssertFalse(ExceptionRaised);
+
+    ExceptionRaised := False;
+    try
+      ds.Fields.CheckFieldNames('Field1;NonExistentField');
+    except
+      ExceptionRaised := True;
+    end;
+    AssertTrue(ExceptionRaised);
+  finally
+    ds.Destroy;
+  end;
+end;
+
+procedure TTestBasics.TestFindField;
+var
+  ds: TDataSet;
+  F: TField;
+begin
+  ds := CreateDatasetWith3Fields;
+  try
+    F := ds.FindField('');
+    AssertTrue(F = nil);
+
+    F := ds.FindField('field3');
+    AssertTrue(F <> nil);
+
+    F := ds.FindField('NonExistentField');
+    AssertTrue(F = nil);
+  finally
+    ds.Destroy;
+  end;
+end;
+
 initialization
   RegisterTest(TTestBasics);
 end.