Browse Source

* fixed writing of widestrings

git-svn-id: trunk@7645 -
Jonas Maebe 18 years ago
parent
commit
ceaaa0e552
3 changed files with 37 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 4 1
      rtl/inc/text.inc
  3. 32 0
      tests/test/twide3.pp

+ 1 - 0
.gitattributes

@@ -7008,6 +7008,7 @@ tests/test/tvarset1.pp svneol=native#text/plain
 tests/test/tw6727.pp svneol=native#text/plain
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
+tests/test/twide3.pp svneol=native#text/plain
 tests/test/twrstr1.pp svneol=native#text/plain
 tests/test/twrstr2.pp svneol=native#text/plain
 tests/test/twrstr3.pp svneol=native#text/plain

+ 4 - 1
rtl/inc/text.inc

@@ -623,6 +623,7 @@ Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; const S : WideStr
 }
 var
   SLen : longint;
+  a: ansistring;
 begin
   If (pointer(S)=nil) or (InOutRes<>0) then
    exit;
@@ -632,7 +633,9 @@ begin
         SLen:=Length(s);
         If Len>SLen Then
           fpc_WriteBlanks(f,Len-SLen);
-        fpc_WriteBuffer(f,PChar(AnsiString(S))^,SLen);
+        a:=s;
+        { length(a) can be > slen, e.g. after utf-16 -> utf-8 }
+        fpc_WriteBuffer(f,pchar(a)^,length(a));
       end;
     fmInput: InOutRes:=105
     else InOutRes:=103;

+ 32 - 0
tests/test/twide3.pp

@@ -0,0 +1,32 @@
+{$codepage utf-8}
+
+{$mode objfpc}
+uses
+{$ifdef unix}
+  cwstring,
+{$endif}
+  sysutils;
+
+{$i+}
+
+var
+  t: text;
+  w: widestring;
+  a: ansistring;
+
+begin
+  assign(t,'twide3.txt');
+  rewrite(t);
+  writeln(t,'łóżka');
+  close(t);
+  reset(t);
+  try
+    readln(t,a);
+    w:=a;
+    if (w<>'łóżka') then
+      raise Exception.create('wrong string read');
+  finally
+    close(t);
+    erase(t);
+  end;
+end.