* 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

@@ -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

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

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}

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}
 

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}

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;
 
 

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;
 
 

tests/tbs/tb0600.pp

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