paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 00:10:31 +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/tb0596.pp svneol=native#text/pascal
tests/tbs/tb0597.pp svneol=native#text/plain tests/tbs/tb0597.pp svneol=native#text/plain
tests/tbs/tb0598.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/tb205.pp svneol=native#text/plain
tests/tbs/tbs0594.pp svneol=native#text/pascal tests/tbs/tbs0594.pp svneol=native#text/pascal
tests/tbs/ub0060.pp svneol=native#text/plain 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 // Delphi converts UniocodeChar to ansistring at the compile time
// old behavior: // old behavior:
// hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))); // 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, result:=ccallnode.createinternres('fpc_uchar_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true), para,resultdef);
ccallparanode.create(left,nil)),resultdef);
left:=nil; left:=nil;
exit; exit;
end end
@ -1159,57 +1161,35 @@ implementation
(torddef(left.resultdef).ordtype=uwidechar) or (torddef(left.resultdef).ordtype=uwidechar) or
(target_info.system in systems_managed_vm) then (target_info.system in systems_managed_vm) then
begin 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 begin
{ parameter } procname:='fpc_char_to_';
para:=ccallparanode.create(left,nil); if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then
{ encoding required? } if nf_explicit in flags then
if tstringdef(resultdef).stringtype=st_ansistring then Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename)
para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para); else
Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename);
{ 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);
end end
else else
begin begin
if nf_explicit in flags then procname:='fpc_uchar_to_';
Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename) if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
else if nf_explicit in flags then
Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename); Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename)
newblock:=internalstatements(newstat); else
restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename);
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;
end; end;
procname:=procname+tstringdef(resultdef).stringtypname;
{ and finally the call }
result:=ccallnode.createinternres(procname,para,resultdef);
left := nil; left := nil;
end end
else 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_Char(const c : UnicodeChar): Char; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; 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; 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; Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}

8
rtl/inc/ustrings.inc
View File

@ -598,7 +598,11 @@ end;
{$ifndef FPC_HAS_UCHAR_TO_SHORTSTR} {$ifndef FPC_HAS_UCHAR_TO_SHORTSTR}
{$define 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; Converts a WideChar to a ShortString;
} }
@ -606,7 +610,7 @@ var
s: ansistring; s: ansistring;
begin begin
widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1); widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s; result:=s;
end; end;
{$endif FPC_HAS_UCHAR_TO_SHORTSTR} {$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_assign(len:longint;sstr,dstr:pointer); compilerproc;
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc; procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
{ JVM-specific } { 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; 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_Char(const c : UnicodeChar): AnsiChar; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; 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; 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; Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}

6
rtl/java/jsstrings.inc
View File

@ -220,13 +220,13 @@ end;
{$define FPC_HAS_CHAR_TO_SHORTSTR} {$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; Converts an AnsiChar to a ShortString;
} }
begin begin
setlength(res,1); setlength(result,1);
ShortstringClass(@res).fdata[0]:=c; ShortstringClass(@result).fdata[0]:=c;
end; end;

4
rtl/java/justrings.inc
View File

@ -321,7 +321,7 @@ end;
{$define FPC_HAS_UCHAR_TO_SHORTSTR} {$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; Converts a UnicodeChar to a AnsiString;
} }
@ -329,7 +329,7 @@ var
u: unicodestring; u: unicodestring;
begin begin
u:=c; u:=c;
res:=u; result:=u;
end; 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.