paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 22:10:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

merge r14132 from cpstrnew branch by paul:

Browse Source 
- a set of rtl changes from AnsiString to RawByteString to various conversion functions
- a test which proves output in cp1251 and cp866 codepages (standard for Russian windows)

git-svn-id: trunk@19093 -
This commit is contained in:
paul 2011-09-17 11:39:13 +00:00
parent 2023b618ac
commit 2162add8ac
8 changed files with 57 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9942,6 +9942,7 @@ tests/test/tcpstr2a.pp svneol=native#text/plain
tests/test/tcpstr3.pp svneol=native#text/plain
tests/test/tcpstr4.pp svneol=native#text/plain
tests/test/tcpstr5.pp svneol=native#text/plain
tests/test/tcpstr6.pp svneol=native#text/plain
tests/test/tcstring1.pp svneol=native#text/pascal
tests/test/tcstring2.pp svneol=native#text/pascal
tests/test/tdel1.pp svneol=native#text/plain

2
rtl/inc/compproc.inc
View File

@ -313,7 +313,7 @@ procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString);
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString;cp : TSystemCodePage): AnsiString; compilerproc;
Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc;
Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
{$ifndef STR_CONCAT_PROCS}
Function fpc_WideStr_Concat (const S1,S2 : WideString) : WideString; compilerproc;

16
rtl/inc/ustringh.inc
View File

@ -19,8 +19,8 @@ Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNI
Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : RawByteString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : UnicodeString; Const s : RawByteString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function UpCase(const s : UnicodeString) : UnicodeString;
@ -32,7 +32,7 @@ Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
function WideCharToString(S : PWideChar) : UnicodeString;
function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
function StringToWideChar(const Src : RawByteString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : UnicodeString;
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : UnicodeString);
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
@ -40,20 +40,20 @@ procedure WideCharToStrVar(S : PWideChar;out Dest : UnicodeString);
procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
function UnicodeCharToString(S : PUnicodeChar) : UnicodeString;
function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
function StringToUnicodeChar(const Src : RawByteString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : UnicodeString;
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : UnicodeString);
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
procedure DefaultAnsi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
Type
{ hooks for internationalization
please add new procedures at the end, it makes it easier to detect new procedures }
TUnicodeStringManager = record
Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
Ansi2WideMoveProc : procedure(source:pchar;cp : TSystemCodePage;var dest:widestring;len:SizeInt);
// UpperUTF8 : procedure(p:PUTF8String);
@ -95,7 +95,7 @@ Type
ThreadFiniProc : procedure;
{ this is only different on windows }
Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
Ansi2UnicodeMoveProc : procedure(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
@ -110,7 +110,7 @@ function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): Si
function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
function UTF8Encode(const s : Ansistring) : UTF8String; inline;
function UTF8Encode(const s : RawByteString) : UTF8String; inline;
function UTF8Encode(const s : UnicodeString) : UTF8String;
function UTF8Decode(const s : UTF8String): UnicodeString;
function AnsiToUtf8(const s : RawByteString): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}

12
rtl/inc/ustrings.inc
View File

@ -59,7 +59,7 @@ Const
These routines can be overwritten for the Current Locale
}
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
var
i : SizeInt;
p : PAnsiChar;
@ -1400,7 +1400,7 @@ function UnicodeCharToString(S : PUnicodeChar) : UnicodeString;
end;
function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
function StringToUnicodeChar(const Src : RawByteString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
var
temp:unicodestring;
begin
@ -1423,7 +1423,7 @@ function WideCharToString(S : PWideChar) : UnicodeString;
end;
function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
function StringToWideChar(const Src : RawByteString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
var
temp:widestring;
begin
@ -1596,7 +1596,7 @@ begin
end;
Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : RawByteString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
result:=Pos(UnicodeString(c),s);
end;
@ -1608,7 +1608,7 @@ Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEM
end;
Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : UnicodeString; Const s : RawByteString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
result:=Pos(c,UnicodeString(s));
end;
@ -2339,7 +2339,7 @@ function UTF8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar
end;
function UTF8Encode(const s : Ansistring) : UTF8String; inline;
function UTF8Encode(const s : RawByteString) : UTF8String; inline;
begin
Result:=UTF8Encode(UnicodeString(s));
end;

6
rtl/inc/wstringh.inc
View File

@ -19,9 +19,9 @@ Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
Function Pos (c : Char; Const s : WideString) : SizeInt;
Function Pos (c : WideChar; Const s : WideString) : SizeInt;
Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : WideChar; Const s : RawByteString) : SizeInt;
Function Pos (c : RawByteString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : WideString; Const s : RawByteString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function UpCase(const s : WideString) : WideString;

16
rtl/inc/wstrings.inc
View File

@ -275,17 +275,23 @@ begin
end;
Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc;
{
Converts an AnsiString to a WideString;
}
Var
Size : SizeInt;
cp: TSystemCodePage;
begin
result:='';
Size:=Length(S2);
if Size>0 then
widestringmanager.Ansi2WideMoveProc(PChar(S2),StringCodePage(S2),result,Size);
begin
cp:=StringCodePage(S2);
if cp=$ffff then
cp:=DefaultSystemCodePage;
widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size);
end;
end;
@ -901,13 +907,13 @@ begin
end;
Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
Function Pos (c : WideChar; Const s : RawByteString) : SizeInt;
begin
result:=Pos(c,WideString(s));
end;
Function Pos (c : AnsiString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : RawByteString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
result:=Pos(WideString(c),s);
end;
@ -919,7 +925,7 @@ Function Pos (c : ShortString; Const s : WideString) : SizeInt;{$ifdef SYSTEMINL
end;
Function Pos (c : WideString; Const s : AnsiString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Pos (c : WideString; Const s : RawByteString) : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
result:=Pos(c,WideString(s));
end;

4
rtl/win/syswin.inc
View File

@ -303,7 +303,7 @@ function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharLowerBuffW';
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
var
destlen: SizeInt;
begin
@ -357,7 +357,7 @@ function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
Widestring
******************************************************************************}
procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure Win32Wide2AnsiMove(source:pwidechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
var
destlen: SizeInt;
begin

25
tests/test/tcpstr6.pp Normal file
View File

@ -0,0 +1,25 @@
// file encoding is cp1251
type
Cp866String = string<866>;
Cp1251String = string<1251>;
procedure WriteString(const s: RawByteString);
begin
Write(StringCodePage(s), ' : ');
WriteLn(s);
end;
var
u : UnicodeString;
c1251: Cp1251String;
c866: Cp866String;
begin
c1251 := 'Ïðèâåò';
WriteString(c1251);
u := c1251;
WriteString(u);
c866 := c1251;
c866 := c866 + c1251;
WriteString(c866);
end.