paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 19:26:09 +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
procname := 'fpc_char_to_shortstr'
else
procname := 'fpc_wchar_to_shortstr';
procname := 'fpc_uchar_to_shortstr';
addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create(
ctemprefnode.create(restemp),nil))));
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_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
{$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}
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_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(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 Delete (Var S : UnicodeString; Index,Size: SizeInt);

21
rtl/inc/ustrings.inc
View File

@ -1673,6 +1673,27 @@ begin
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);
begin
SetLength(S,Len);

8
tests/tbs/tb0429.pp
View File

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