+ WC_NO_BEST_FIT_CHARS

* use WC_NO_BEST_FIT_CHARS when calling WideCharToMultiByte
* made tiwde6 more verbose

git-svn-id: trunk@9481 -

rtl/inc/wstringh.inc

@@ -41,6 +41,8 @@ procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt)
 procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
 
 Type
+  { hooks for internationalization
+    please add new procedures at the end, it makes it easier to detect new procedures }
   TWideStringManager = record
     Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
     Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);

rtl/win/sysutils.pp

@@ -1079,7 +1079,6 @@ end;
                     Target Dependent WideString stuff
 ****************************************************************************}
 
-
 function Win32CompareWideString(const s1, s2 : WideString) : PtrInt;
   begin
     SetLastError(0);
@@ -1182,6 +1181,7 @@ function Win32AnsiStrUpper(Str: PChar): PChar;
   are relevant already for the system unit }
 procedure InitWin32Widestrings;
   begin
+//!!!    CharLengthPCharProc : function(const Str: PChar): PtrInt;
     widestringmanager.CompareWideStringProc:=@Win32CompareWideString;
     widestringmanager.CompareTextWideStringProc:=@Win32CompareTextWideString;
     widestringmanager.UpperAnsiStringProc:=@Win32AnsiUpperCase;

rtl/win/wininc/defines.inc

@@ -2809,6 +2809,7 @@
      WC_DISCARDNS = 16;
      WC_SEPCHARS = 32;
      WC_DEFAULTCHAR = 64;
+     WC_NO_BEST_FIT_CHARS = $400;
   { WinHelp  }
      HELP_COMMAND = $102;
      HELP_CONTENTS = $3;

rtl/win32/system.pp

@@ -930,6 +930,7 @@ const
   { MultiByteToWideChar  }
      MB_PRECOMPOSED = 1;
      CP_ACP = 0;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
     stdcall; external 'kernel32' name 'MultiByteToWideChar';
@@ -947,10 +948,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
   end;
 
 procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

rtl/win64/system.pp

@@ -952,6 +952,7 @@ const
   { MultiByteToWideChar  }
      MB_PRECOMPOSED = 1;
      CP_ACP = 0;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
     stdcall; external 'kernel32' name 'MultiByteToWideChar';
@@ -969,10 +970,10 @@ procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   begin
     // retrieve length including trailing #0
     // not anymore, because this must also be usable for single characters
-    destlen:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil);
+    destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
     // this will null-terminate
     setlength(dest, destlen);
-    WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], destlen, nil, nil);
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
   end;
 
 procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);

rtl/wince/system.pp

@@ -310,6 +310,7 @@ const
      MB_USEGLYPHCHARS = 4;
      CP_ACP = 0;
      CP_OEMCP = 1;
+     WC_NO_BEST_FIT_CHARS = $400;
 
 function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
      cdecl; external 'coredll' name 'MultiByteToWideChar';
@@ -336,7 +337,7 @@ end;
 
 function WideToAnsiBuf(WideBuf: PWideChar; WideCharsLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint;
 begin
-  Result := WideCharToMultiByte(CP_ACP, 0, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
+  Result := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, WideBuf, WideCharsLen, AnsiBuf, AnsiBufLen, nil, nil);
   if ((WideCharsLen <> -1) or (Result = 0)) and (AnsiBuf <> nil) then
   begin
     if Result + 1 > AnsiBufLen then

tests/test/twide6.pp

@@ -5,6 +5,12 @@ uses
  {$endif}
   sysutils;
 
+procedure doerror(i : integer);
+  begin
+    writeln('Error: ',i);
+    halt(i);
+  end;
+
 
 { normal upper case testing }
 procedure testupper;
@@ -21,6 +27,9 @@ begin
   writeln('original upper: ',w2);
 {$endif print}
   s:=w1;
+{$ifdef print}
+  writeln('ansi: ',s);
+{$endif print}
   w3:=s;
   w4:=AnsiUpperCase(s);
   { filter out unsupported characters }
@@ -33,12 +42,13 @@ begin
   w1:=wideuppercase(w1);
 {$ifdef print}
   writeln('wideupper: ',w1);
+  writeln('original upper: ',w2);
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(1);
+    doerror(1);
   if (w4 <> w2) then
-    halt(2);
+    doerror(2);
 
   w1:='aéèàł'#$d87e#$dc04;
   w2:='AÉÈÀŁ'#$d87e#$dc04;
@@ -58,9 +68,9 @@ begin
   writeln('ansistrupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(1);
+    doerror(21);
   if (w4 <> w2) then
-    halt(2);
+    doerror(22);
 
 end;
 
@@ -95,9 +105,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(3);
+    doerror(3);
   if (w4 <> w2) then
-    halt(4);
+    doerror(4);
 
 
   w1:='AÉÈÀŁ'#$d87e#$dc04;
@@ -118,9 +128,9 @@ begin
   writeln('ansistrlower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(3);
+    doerror(3);
   if (w4 <> w2) then
-    halt(4);
+    doerror(4);
 end;
 
 
@@ -156,9 +166,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(5);
+    doerror(5);
   if (w4 <> w2) then
-    halt(6);
+    doerror(6);
 end;
 
 
@@ -193,9 +203,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(7);
+    doerror(7);
   if (w4 <> w2) then
-    halt(8);
+    doerror(8);
 end;
 
 
@@ -231,9 +241,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(9);
+    doerror(9);
   if (w4 <> w2) then
-    halt(10);
+    doerror(10);
 end;
 
 
@@ -268,9 +278,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(11);
+    doerror(11);
   if (w4 <> w2) then
-    halt(12);
+    doerror(12);
 end;
 
 
@@ -312,9 +322,9 @@ begin
   writeln('ansiupper: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(13);
+    doerror(13);
   if (w4 <> w2) then
-    halt(14);
+    doerror(14);
 end;
 
 
@@ -356,9 +366,9 @@ begin
   writeln('ansilower: ',w4);
 {$endif print}
   if (w1 <> w2) then
-    halt(15);
+    doerror(15);
   if (w4 <> w2) then
-    halt(16);
+    doerror(16);
 end;