--- Merging r20882 into '.':

C    packages/fcl-db/tests/testbasics.pas
U    packages/fcl-db/src/base/db.pas
Summary of conflicts:
  Text conflicts: 1

# revisions: 20882
r20882 | michael | 2012-04-15 13:52:15 +0200 (Sun, 15 Apr 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas
   M /trunk/packages/fcl-db/tests/testbasics.pas

* Patch and testcase from Luiz Americo to fix ExtractFieldName (bug 21777)

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

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

@@ -2139,20 +2139,17 @@ begin
     DatabaseErrorFmt(Fmt, Args);
 end;
 
-Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
-
+function ExtractFieldName(const Fields: string; var Pos: Integer): string;
 var
-  i: integer;
+  i: Integer;
+  FieldsLength: Integer;
 begin
-  for i := Pos to Length(Fields) do begin
-    if Fields[i] = ';' then begin
-      Result := Copy(Fields, Pos, i - Pos);
-      Pos := i + 1;
-      Exit;
-    end;
-  end;
-  Result := Copy(Fields, Pos, Length(Fields));
-  Pos := Length(Fields) + 1;
+  i:=Pos;
+  FieldsLength:=Length(Fields);
+  while (i<=FieldsLength) and (Fields[i]<>';') do Inc(i);
+  Result:=Trim(Copy(Fields,Pos,i-Pos));
+  if (i<=FieldsLength) and (Fields[i]=';') then Inc(i);
+  Pos:=i;
 end;
 
 { EUpdateError }

packages/fcl-db/tests/testbasics.pas

@@ -24,6 +24,7 @@ type
     procedure TestFieldDefWithoutDS;
     procedure TestGetParamList;
     procedure TestGetFieldList;
+    procedure TestExtractFieldName;
   end;
 
 implementation
@@ -314,6 +315,45 @@ begin
   end;
 end;
 
+procedure TTestBasics.TestExtractFieldName;
+var
+  i: Integer;
+  Fields: String;
+  FieldName: String;
+begin
+  Fields := '';
+  i := 1;
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(1, i);
+  AssertEquals('', FieldName);
+
+  Fields := 'test';
+  i := 1;
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(5, i);
+  AssertEquals('test', FieldName);
+
+  Fields := 'test;';
+  i := 1;
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(6, i);
+  AssertEquals('test', FieldName);
+
+  Fields := ' test ';
+  i := 1;
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(7, i);
+  AssertEquals('test', FieldName);
+
+  Fields := 'test;xxx';
+  i := 1;
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(6, i);
+  AssertEquals('test', FieldName);
+  FieldName := ExtractFieldName(Fields, i);
+  AssertEquals(9, i);
+  AssertEquals('xxx', FieldName);
+end;
 
 initialization
   RegisterTest(TTestBasics);