* fixed reading utf-8 strings from streams (based on patch by Anton

Kavalenka, mantis #13015)

git-svn-id: trunk@12777 -

.gitattributes

@@ -8757,6 +8757,7 @@ tests/webtbs/tw12942.pp svneol=native#text/plain
 tests/webtbs/tw1295.pp svneol=native#text/plain
 tests/webtbs/tw1299.pp svneol=native#text/plain
 tests/webtbs/tw12993.pp svneol=native#text/plain
+tests/webtbs/tw13015.pp svneol=native#text/plain
 tests/webtbs/tw13019.pp svneol=native#text/plain
 tests/webtbs/tw1310.pp svneol=native#text/plain
 tests/webtbs/tw13133.pp svneol=native#text/plain
@@ -9652,6 +9653,7 @@ tests/webtbs/uw11182.pp svneol=native#text/plain
 tests/webtbs/uw11762.pp svneol=native#text/plain
 tests/webtbs/uw1181.inc svneol=native#text/plain
 tests/webtbs/uw1279.pp svneol=native#text/plain
+tests/webtbs/uw13015.pp svneol=native#text/plain
 tests/webtbs/uw1331.pp svneol=native#text/plain
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain

rtl/objpas/classes/reader.inc

@@ -307,19 +307,21 @@ var
   i: Integer;
 begin
   case StringType of
-    vaString:
+   vaLString,vaUTF8String:
+     i:=ReadDWord;
+  else
+  //vaString:
       begin
         Read(b, 1);
         i := b;
       end;
-    vaLString:
-      i:=ReadDWord;
   end;
   SetLength(Result, i);
   if i > 0 then
     Read(Pointer(@Result[1])^, i);
 end;
 
+
 function TBinaryObjectReader.ReadWideString: WideString;
 var
   len: DWord;
@@ -1415,12 +1417,16 @@ function TReader.ReadWideString: WideString;
 var
  s: String;
  i: Integer;
+ vt:TValueType;
 begin
   if NextValue in [vaWString,vaUString,vaUTF8String] then
-    //vaUTF8String needs conversion? 2008-09-06 mse
+    //vaUTF8String needs conversion? 2008-09-06 mse, YES!! AntonK
     begin
-      ReadValue;
+      vt:=ReadValue;
-      Result := FDriver.ReadWideString
+      if vt=vaUTF8String then
+        Result := utf8decode(fDriver.ReadString(vaLString))
+      else
+        Result := FDriver.ReadWideString
     end
   else
     begin
@@ -1438,12 +1444,16 @@ function TReader.ReadUnicodeString: UnicodeString;
 var
  s: String;
  i: Integer;
+ vt:TValueType;
 begin
   if NextValue in [vaWString,vaUString,vaUTF8String] then
-    //vaUTF8String needs conversion? 2008-09-06 mse
+    //vaUTF8String needs conversion? 2008-09-06 mse, YES!! AntonK
     begin
-      ReadValue;
+      vt:=ReadValue;
-      Result := FDriver.ReadUnicodeString
+      if vt=vaUTF8String then
+        Result := utf8decode(fDriver.ReadString(vaLString))
+      else
+        Result := FDriver.ReadWideString
     end
   else
     begin

tests/webtbs/tw13015.pp

@@ -0,0 +1,86 @@
+{ %FILES=tw13015-utf8.bin }
+
+program test;
+
+{$ifdef FPC}
+{$mode delphi}
+{$endif}
+{$ifdef windows}
+{$apptype console}
+{$endif}
+
+uses
+{$ifdef unix}
+ cwstring,
+{$endif}
+ Classes,SysUtils,uw13015;
+
+procedure writefile(const fn: string);
+var
+  f:TStream;
+  tc:TTestClass;
+begin
+  writeln('Write component with widestring property to stream');
+  tc:=TTestClass.Create(nil);
+  writeln('tc.Wstr=',tc.Wstr);
+  write('tc.DumpAndCheck()');
+  tc.DumpAndCheck;
+     
+  f:=TFileStream.Create(fn,fmCreate);
+  try
+    f.WriteComponent(tc);
+  finally
+    f.Free;
+  end;
+
+  tc.free;
+end;
+
+
+procedure readfile(const fn: string);
+var
+  f:TStream;
+  tc:TTestClass;
+begin
+  writeln('Reading component with widestring property');
+  f:=TFileStream.Create(fn,fmOpenRead);
+  try
+    tc:=TTestClass(f.ReadComponent(nil));
+    if Assigned(tc) then
+      begin
+        writeln('tc.Wstr=',tc.Wstr);
+        write('tc.DumpAndCheck()');
+        tc.DumpAndCheck;
+      end;
+  finally
+    f.Free;
+  end;
+
+  tc.free;
+end;
+
+
+const utf8str : array[0..84] of char=(
+  'T','P','F','0',#010,'T','T','e','s','t','C','l','a','s','s',
+  #000,#004,'W','s','t','r',#020,'9',#000,#000,#000,#208,#191,#209,#128,
+  #208,#184,#208,#178,#208,#181,#209,#130,',',' ',#208,#191,#209,#128,#209,
+  #139,#208,#178,#209,#150,#209,#130,#208,#176,#208,#189,#209,#140,#208,#189,
+  #208,#181,' ','-',' ','p','r',#195,#188,'f','u','n','g',' ','s',
+  'p','a',#195,#159,' ','g','u','t',#000,#000);
+
+var
+  f: file;
+begin
+  RegisterClasses([TTestClass]);
+
+  WriteFile('test.bin');
+  ReadFile('test.bin');
+  DeleteFile('test.bin');
+  
+  assign(f,'tw13015-utf8.bin');
+  rewrite(f,1);
+  blockwrite(f,utf8str,sizeof(utf8str));
+  close(f);
+  ReadFile('tw13015-utf8.bin');
+  DeleteFile('tw13015-utf8.bin');
+end.

tests/webtbs/uw13015.pp

@@ -0,0 +1,63 @@
+unit uw13015; 
+
+{$ifdef FPC}
+{$mode delphi}
+{$endif}
+
+interface
+
+uses
+  Classes;
+  
+type
+  TTestClass=class(TComponent)
+  private
+    fWStr:WideString;
+  public
+    constructor Create(AnOwner:TComponent);override;
+    procedure DumpAndCheck;
+  published
+    property Wstr:WideString read fWStr write fWStr;
+  end;
+
+const
+   {$ifdef fpc}
+   ws:WideString=#$43f#$440#$438#$432#$435#$442', '#$43f#$440#$44B#$432#$456#$442#$430#$43d#$44c#$43d#$435' - pr'#$fc'fung spa'#$df' gut';
+   {$else}
+   ws:WideString='ïðèâåò, ïðûâ³òàíüíå - prufung spa'#$df' gut';
+   {$endif}
+   
+   
+procedure Register;
+
+implementation
+uses SysUtils;
+
+constructor TTestClass.Create(AnOwner:TComponent);
+begin
+     inherited Create(AnOwner);
+     fWStr:=ws;
+end;
+
+
+procedure TTestClass.DumpAndCheck;
+var
+   i,w:integer;
+begin
+     for i:=1 to length(fWstr) do
+     begin
+          w:=Word(fWstr[i]);
+          write(format('%.04x ',[w]));
+          if w<>word(ws[i]) then
+            halt(1);
+     end;
+     writeln;
+end;
+
+
+procedure Register; 
+begin
+     RegisterComponents('tc',[TTestClass]);
+end; 
+
+end.