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

* changed fpc_(u)char_to_shortstr() from a procedure into a function, like

Browse Source 
the other fpc_(u)char_to_*str() routines (exception dates back to the
    time calls to these routines were still inserted "manually" in the
    compiler). Fixes the compilation of "shortstr:=widecharconstant" after
    r23613 and simplifies other code calling this helper + test

git-svn-id: branches/cpstrrtl@25428 -
This commit is contained in:
Jonas Maebe 2013-09-06 08:02:46 +00:00
parent 5be1a905e8
commit 3c3ad705f1
8 changed files with 56 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10010,6 +10010,7 @@ tests/tbs/tb0595.pp svneol=native#text/plain
tests/tbs/tb0596.pp svneol=native#text/pascal
tests/tbs/tb0597.pp svneol=native#text/plain
tests/tbs/tb0598.pp svneol=native#text/plain
tests/tbs/tb0600.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tbs0594.pp svneol=native#text/pascal
tests/tbs/ub0060.pp svneol=native#text/plain

76
compiler/ncnv.pas
View File

@ -1125,9 +1125,11 @@ implementation
// Delphi converts UniocodeChar to ansistring at the compile time
// old behavior:
// hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)));
para:=ccallparanode.create(left,nil);
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);
result:=ccallnode.createinternres('fpc_uchar_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
ccallparanode.create(left,nil)),resultdef);
para,resultdef);
left:=nil;
exit;
end
@ -1159,57 +1161,35 @@ implementation
(torddef(left.resultdef).ordtype=uwidechar) or
(target_info.system in systems_managed_vm) then
begin
if (tstringdef(resultdef).stringtype<>st_shortstring) then
{ parameter }
para:=ccallparanode.create(left,nil);
{ encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);
{ create the procname }
if torddef(left.resultdef).ordtype<>uwidechar then
begin
{ parameter }
para:=ccallparanode.create(left,nil);
{ encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);
{ create the procname }
if torddef(left.resultdef).ordtype<>uwidechar then
begin
procname:='fpc_char_to_';
if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
if nf_explicit in flags then
Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
else
Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
end
else
begin
procname:='fpc_uchar_to_';
if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
if nf_explicit in flags then
Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
else
Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
end;
procname:=procname+tstringdef(resultdef).stringtypname;
{ and finally the call }
result:=ccallnode.createinternres(procname,para,resultdef);
procname:='fpc_char_to_';
if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
if nf_explicit in flags then
Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
else
Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
end
else
begin
if nf_explicit in flags then
Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
else
Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
newblock:=internalstatements(newstat);
restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
addstatement(newstat,restemp);
if torddef(left.resultdef).ordtype<>uwidechar then
procname := 'fpc_char_to_shortstr'
else
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));
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
procname:='fpc_uchar_to_';
if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
if nf_explicit in flags then
Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
else
Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
end;
procname:=procname+tstringdef(resultdef).stringtypname;
{ and finally the call }
result:=ccallnode.createinternres(procname,para,resultdef);
left := nil;
end
else

6
rtl/inc/compproc.inc
View File

@ -357,7 +357,11 @@ Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc;
Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$ifdef VER2_6}
procedure fpc_UChar_To_ShortStr(out result : shortstring;const c : WideChar) compilerproc;
{$else}
function fpc_UChar_To_ShortStr(const c : WideChar): shortstring; compilerproc;
{$endif}
Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}

8
rtl/inc/ustrings.inc
View File

@ -598,7 +598,11 @@ end;
{$ifndef FPC_HAS_UCHAR_TO_SHORTSTR}
{$define FPC_HAS_UCHAR_TO_SHORTSTR}
procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$ifdef VER2_6}
procedure fpc_UChar_To_ShortStr(out result : shortstring;const c : WideChar); compilerproc;
{$else}
function fpc_UChar_To_ShortStr(const c : WideChar): shortstring; compilerproc;
{$endif}
{
Converts a WideChar to a ShortString;
}
@ -606,7 +610,7 @@ var
s: ansistring;
begin
widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s;
result:=s;
end;
{$endif FPC_HAS_UCHAR_TO_SHORTSTR}

4
rtl/java/jcompproc.inc
View File

@ -36,7 +36,7 @@ procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
//procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer); compilerproc;
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
{ JVM-specific }
procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
function fpc_Char_To_ShortStr(const c : AnsiChar): ShortString; compilerproc;
procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
@ -285,7 +285,7 @@ Function fpc_Char_To_UChar(const c : AnsiChar): UnicodeChar; compilerproc;
Function fpc_UChar_To_Char(const c : UnicodeChar): AnsiChar; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc;
function fpc_UChar_To_ShortStr(const c : UnicodeChar): shortstring; compilerproc;
Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}

6
rtl/java/jsstrings.inc
View File

@ -220,13 +220,13 @@ end;
{$define FPC_HAS_CHAR_TO_SHORTSTR}
procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
function fpc_Char_To_ShortStr(const c : AnsiChar): shortstring; compilerproc;
{
Converts an AnsiChar to a ShortString;
}
begin
setlength(res,1);
ShortstringClass(@res).fdata[0]:=c;
setlength(result,1);
ShortstringClass(@result).fdata[0]:=c;
end;

4
rtl/java/justrings.inc
View File

@ -321,7 +321,7 @@ end;
{$define FPC_HAS_UCHAR_TO_SHORTSTR}
procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc;
function fpc_UChar_To_ShortStr(const c : UnicodeChar): shortstring; compilerproc;
{
Converts a UnicodeChar to a AnsiString;
}
@ -329,7 +329,7 @@ var
u: unicodestring;
begin
u:=c;
res:=u;
result:=u;
end;

9
tests/tbs/tb0600.pp Normal file
View File

@ -0,0 +1,9 @@
{$ifdef fpc}
{$mode delphi}
{$endif}
var
s: shortstring;
begin
s:=#$1234;
end.