From 3c3ad705f158940a10b6280611430b477ce2ed94 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Fri, 6 Sep 2013 08:02:46 +0000 Subject: [PATCH] * changed fpc_(u)char_to_shortstr() from a procedure into a function, like 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 - --- .gitattributes | 1 + compiler/ncnv.pas | 76 ++++++++++++++++-------------------------- rtl/inc/compproc.inc | 6 +++- rtl/inc/ustrings.inc | 8 +++-- rtl/java/jcompproc.inc | 4 +-- rtl/java/jsstrings.inc | 6 ++-- rtl/java/justrings.inc | 4 +-- tests/tbs/tb0600.pp | 9 +++++ 8 files changed, 56 insertions(+), 58 deletions(-) create mode 100644 tests/tbs/tb0600.pp diff --git a/.gitattributes b/.gitattributes index ad89c6d299..578ad27855 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index ff86f65ce5..2a9fbe9081 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -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 diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index a8819f3e26..1a99bf72b2 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -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} diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index 63267ba9e3..a18938dd75 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -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} diff --git a/rtl/java/jcompproc.inc b/rtl/java/jcompproc.inc index 9b5add99c7..93ce4f959a 100644 --- a/rtl/java/jcompproc.inc +++ b/rtl/java/jcompproc.inc @@ -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} diff --git a/rtl/java/jsstrings.inc b/rtl/java/jsstrings.inc index c48574c194..d35fb84a0f 100644 --- a/rtl/java/jsstrings.inc +++ b/rtl/java/jsstrings.inc @@ -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; diff --git a/rtl/java/justrings.inc b/rtl/java/justrings.inc index fd2c219a2e..1c1b3b6903 100644 --- a/rtl/java/justrings.inc +++ b/rtl/java/justrings.inc @@ -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; diff --git a/tests/tbs/tb0600.pp b/tests/tbs/tb0600.pp new file mode 100644 index 0000000000..d7279db8aa --- /dev/null +++ b/tests/tbs/tb0600.pp @@ -0,0 +1,9 @@ +{$ifdef fpc} +{$mode delphi} +{$endif} + +var + s: shortstring; +begin + s:=#$1234; +end.