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

* renamed fpc_WChar_To_ShortStr() compilerproc to fpc_UChar_To_ShortStr() for

Browse Source 
consistency with other helpers
  + added lowercase(unicodechar) and lowercase(unicodestring) overloads (for some
    reason only upcase() existed for them)

git-svn-id: branches/jvmbackend@18881 -
This commit is contained in:
Jonas Maebe 2011-08-28 19:22:15 +00:00
parent 1e329866b4
commit 1403e3df29
5 changed files with 30 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/ncnv.pas
View File

@ -1130,7 +1130,7 @@ implementation
if torddef(left.resultdef).ordtype<>uwidechar then if torddef(left.resultdef).ordtype<>uwidechar then
procname := 'fpc_char_to_shortstr' procname := 'fpc_char_to_shortstr'
else else
procname := 'fpc_wchar_to_shortstr'; procname := 'fpc_uchar_to_shortstr';
addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create( addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create(
ctemprefnode.create(restemp),nil)))); ctemprefnode.create(restemp),nil))));
addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));

4
rtl/inc/compproc.inc
View File

@ -442,9 +442,9 @@ Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compiler
Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc; Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc; Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC} {$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc; Function fpc_UChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC} {$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc; procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC} {$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}

2
rtl/inc/ustringh.inc
View File

@ -25,6 +25,8 @@ Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;{$ifdef SYSTEM
Function UpCase(const s : UnicodeString) : UnicodeString; Function UpCase(const s : UnicodeString) : UnicodeString;
Function UpCase(c:UnicodeChar):UnicodeChar; Function UpCase(c:UnicodeChar):UnicodeChar;
Function LowerCase(const s : UnicodeString) : UnicodeString;
Function LowerCase(c:UnicodeChar):UnicodeChar;
Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt);
Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt); Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);

21
rtl/inc/ustrings.inc
View File

@ -1673,6 +1673,27 @@ begin
end; end;
{$ifndef FPC_HAS_LOWERCASE_UNICODECHAR}
{$define FPC_HAS_LOWERCASE_UNICODECHAR}
Function LowerCase(c:UnicodeChar):UnicodeChar;
var
s : UnicodeString;
begin
s:=c;
result:=widestringmanager.LowerUnicodeStringProc(s)[1];
end;
{$endif FPC_HAS_LOWERCASE_UNICODECHAR}
{$ifndef FPC_HAS_LOWERCASE_UNICODESTR}
{$define FPC_HAS_LOWERCASE_UNICODESTR}
function LowerCase(const s : UnicodeString) : UnicodeString;
begin
result:=widestringmanager.LowerUnicodeStringProc(s);
end;
{$endif FPC_HAS_LOWERCASE_UNICODESTR}
Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt); Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
begin begin
SetLength(S,Len); SetLength(S,Len);

8
tests/tbs/tb0429.pp
View File

@ -3,15 +3,15 @@
var var
err : boolean; err : boolean;
procedure lowercase(c:char);overload; procedure test(c:char);overload;
begin begin
writeln('char'); writeln('char');
end; end;
procedure lowercase(c:shortstring);overload; procedure test(c:shortstring);overload;
begin begin
writeln('short'); writeln('short');
end; end;
procedure lowercase(c:ansistring);overload; procedure test(c:ansistring);overload;
begin begin
writeln('ansi'); writeln('ansi');
err:=false; err:=false;
@ -26,7 +26,7 @@ begin
{ this should choosse the ansistring version } { this should choosse the ansistring version }
w:=''; w:='';
for i:=1 to 300 do w:=w+'.'; for i:=1 to 300 do w:=w+'.';
lowercase(w); test(w);
if err then if err then
begin begin
writeln('Wrong lowercase Error!'); writeln('Wrong lowercase Error!');