Browse Source

+ WC_NO_BEST_FIT_CHARS
* use WC_NO_BEST_FIT_CHARS when calling WideCharToMultiByte
* made tiwde6 more verbose

git-svn-id: trunk@9481 -

florian 17 years ago
parent
commit
86e3e79e67
7 changed files with 50 additions and 34 deletions
  1. 2 0
      rtl/inc/wstringh.inc
  2. 1 1
      rtl/win/sysutils.pp
  3. 3 2
      rtl/win/wininc/defines.inc
  4. 3 2
      rtl/win32/system.pp
  5. 3 2
      rtl/win64/system.pp
  6. 4 3
      rtl/wince/system.pp
  7. 34 24
      tests/test/twide6.pp

+ 2 - 0
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);

+ 1 - 1
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;

+ 3 - 2
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;
@@ -5274,7 +5275,7 @@
      STATUS_SXS_EARLY_DEACTIVATION = $C015000F;
      STATUS_SXS_INVALID_DEACTIVATION = $C0150010;
 
-     
+
 {$define EXCEPTION_CTRL_C}
      PROCESSOR_ARCHITECTURE_INTEL = 0;
      PROCESSOR_ARCHITECTURE_MIPS = 1;
@@ -5398,7 +5399,7 @@
      LOGON32_LOGON_NETWORK = $03;
      LOGON32_LOGON_BATCH = $04;
      LOGON32_LOGON_SERVICE = $05;
-     LOGON32_LOGON_UNLOCK  = $07; 
+     LOGON32_LOGON_UNLOCK  = $07;
      LOGON32_LOGON_NETWORK_CLEARTEXT=$08; // $0500+
      LOGON32_LOGON_NEW_CREDENTIALS  =$09; // $0500+
      LOGON32_PROVIDER_DEFAULT = $00;

+ 3 - 2
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);

+ 3 - 2
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);

+ 4 - 3
rtl/wince/system.pp

@@ -175,7 +175,7 @@ function ui64tod(i : qword) : double; compilerproc;
 
 function i64tod(i : int64) : double; compilerproc;
    cdecl;external 'coredll' name '__i64tod';
-   
+
 function utos(i : dword) : single; compilerproc;
    cdecl;external 'coredll' name '__utos';
 
@@ -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
@@ -1789,7 +1790,7 @@ begin
 end;
 
 initialization
-  SysResetFPU;    
+  SysResetFPU;
   if not(IsLibrary) then
     SysInitFPU;
   StackLength := CheckInitialStkLen(InitialStkLen);

+ 34 - 24
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;
 
 
@@ -295,8 +305,8 @@ begin
   { adjust checking values for new length due to corruption }
   if length(w3)<>length(w2) then
     begin
-      setlength(w2,length(w3)); 
-      setlength(w1,length(w3)); 
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
     end;
   w4:=AnsiUpperCase(s);
   { filter out unsupported characters }
@@ -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;
 
 
@@ -339,8 +349,8 @@ begin
   { adjust checking values for new length due to corruption }
   if length(w3)<>length(w2) then
     begin
-      setlength(w2,length(w3)); 
-      setlength(w1,length(w3)); 
+      setlength(w2,length(w3));
+      setlength(w1,length(w3));
     end;
   w4:=AnsiLowerCase(s);
   { filter out unsupported characters }
@@ -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;