* Fix bug ID #31385

git-svn-id: trunk@42974 -

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

@@ -464,9 +464,9 @@ var
 begin
  FD := FieldDefs.Items[FieldNo-1];
  case FD.DataType of
-  ftString,
-    ftGuid:   result:=FD.Size+1;
-  ftFixedChar:result:=FD.Size+1;
+  ftString : Result:=FD.Size*FD.CharSize+1;
+  ftGuid:   result:=FD.Size+1;
+  ftFixedChar:result:=FD.Size*FD.CharSize+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftCurrency,
   ftFloat:    result:=SizeOf(Double);
@@ -1037,7 +1037,7 @@ end;
 
 procedure TMemDataset.calcrecordlayout;
 var
-  i,Count : integer;
+  i,Count,aSize : integer;
 begin
  Count := FieldDefs.Count;
  // Avoid mem-leak if CreateTable is called twice
@@ -1057,8 +1057,9 @@ begin
  for i:= 0 to Count-1 do
    begin
    GetIntegerPointer(FFieldOffsets, i)^ := FRecSize;
-   GetIntegerPointer(FFieldSizes,   i)^ := MDSGetBufferSize(i+1);
-   FRecSize:= FRecSize+GetIntegerPointer(FFieldSizes, i)^;
+   aSize:=MDSGetBufferSize(i+1);
+   GetIntegerPointer(FFieldSizes,   i)^ := aSize;
+   FRecSize:= FRecSize+aSize;
    end;
  FRecInfoOffset:=FRecSize;
  FRecSize:=FRecSize+SizeRecInfo;
@@ -1220,7 +1221,8 @@ var
   AKeyValues: variant;
   i: integer;
   AField: TField;
-  s1,s2: string;
+  s1,s2: UTF8String;
+
 begin
   Result := false;
   SaveState := SetTempState(dsFilter);
@@ -1259,8 +1261,16 @@ begin
           // string fields
           if AField.DataType in [ftString, ftFixedChar] then
           begin
-            s1 := AField.AsString;
-            s2 := VarToStr(AKeyValues[i]);
+            if TStringField(AField).CodePage=CP_UTF8 then
+              begin
+              s1 := AField.AsUTF8String;
+              s2 := UTF8Encode(VarToUnicodeStr(AKeyValues[i]));
+              end
+            else
+              begin
+              s1 := AField.AsString;
+              s2 := VarToStr(AKeyValues[i]);
+              end;
             if loPartialKey in Options then
               s1 := copy(s1, 1, length(s2));
             if loCaseInsensitive in Options then

packages/fcl-db/tests/dbtestframework.pas

@@ -7,6 +7,9 @@ program dbtestframework;
 {$APPTYPE CONSOLE}
 
 uses
+{$ifdef unix}
+  cwstring,
+{$endif}
   SysUtils,
   fpcunit,  testreport, testregistry,
   DigestTestReport,

packages/fcl-db/tests/testspecifictmemdataset.pas

@@ -5,6 +5,7 @@ unit TestSpecificTMemDataSet;
 }
 
 {$mode objfpc}{$H+}
+{$codepage UTF8}
 
 interface
 
@@ -25,6 +26,7 @@ type
     procedure TestFileName;
     procedure TestCopyFromDataset; //is copied dataset identical to original?
     procedure TestCopyFromDatasetMoved; //move record then copy. Is copy identical? Has record position changed?
+    Procedure TestLocateUTF8;
   end;
 
 implementation
@@ -128,6 +130,43 @@ begin
   CheckEquals(CurrentID,NewID,'Mismatch between ID field contents - the record has moved.');
 end;
 
+procedure TTestSpecificTMemDataset.TestLocateUTF8;
+Var
+  MemDataset1: TMemDataset;
+  S : UTF8String;
+begin
+  MemDataset1:=TMemDataset.Create(Nil);
+  With MemDataset1 do
+    try
+    FieldDefs.Add('first',ftString,40,0,true,False,1,cp_UTF8);
+    FieldDefs.Add('second',ftString,40,0,true,False,2,cp_ACP);
+    CreateTable;
+    Active:=True;
+    Append;
+    Fields[0].AsUTF8String:='♯abcd';
+    Fields[1].AsString:='native';
+    Post;
+    Append;
+    Fields[0].AsUTF8String:='défaut';
+    Fields[1].AsString:='morenative';
+    Post;
+    First;
+    While not eof do
+      begin
+      S:=fields[0].AsUTF8String;
+      Writeln(S);
+      next;
+      end;
+    First;
+    AssertTrue('UTF8 1 ok',Locate('first','♯abcd',[]));
+    AssertTrue('UTF8 2 ok',Locate('first','défaut',[]));
+    AssertTrue('ANSI 1 ok',Locate('second','native',[]));
+    AssertTrue('ANSI 1 ok',Locate('second','morenative',[]));
+  finally
+    Free;
+  end;
+end;
+
 
 initialization