merge r17484 from cpstrnew branch by michael:

* Patch from Inoussa:
* defcmp.pas
    ** ansistring to/from RawByteString are evaluated "te_equal"
    ** ansistring to UTF8string is evaluated (te_convert_l1,tc_string_2_string)

* ncnv.pas
    ** "ttypeconvnode.typecheck_char_to_string" : WideChar to AnsiString/ShortString
        is possible if the source code page is not utf8
    ** "ttypeconvnode.typecheck_char_to_char" : WideChar to AnsiChar
        is possible if the source code page is not utf8

* ncon.pas
    ** "tstringconstnode.changestringtype" : Unicode to utf8string bug fix(set the encoding),
       constants in the source code with code page set utf8 should be converted back to utf8

* nopt.pas
    ** "genmultistringadd" : fpc_<stringname>_concat_multi have a new parameter "cp"
        to indicate the "DestS" code page if the variable content is nil. This is required
        in order not to loose the declared code page.

* pinline.pas
    ** "inline_setlength" : a new parameter "cp" to indicate the code page if the variable content
       is nil. This is required in order not to loose the declared code page.
* ptconst.pas
    ** "parse_arraydef" : for string const to array of ansichar/widechar conversion check for wide string and
        convert if it is required. For char const to array of ansichar/widechar conversion check for wide char and
        convert if it is required.

git-svn-id: trunk@19113 -

compiler/defcmp.pas

@@ -349,6 +349,22 @@ implementation
                              eq:=te_convert_l1;
                          end;
                       end
+                     else if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
+                             (tstringdef(def_from).stringtype=st_ansistring) then 
+                      begin
+                        if (tstringdef(def_from).encoding=tstringdef(def_to).encoding) or
+                           (tstringdef(def_from).encoding=globals.CP_NONE) or
+                           (tstringdef(def_to).encoding=globals.CP_NONE) then
+                          eq:=te_equal
+                        else 
+                         begin        
+                           doconv := tc_string_2_string;
+                           if (tstringdef(def_to).encoding=globals.CP_UTF8) then 
+                             eq:=te_convert_l1
+                           else
+                             eq:=te_convert_l2;
+                         end 
+                      end          
                      else
                      { same string type ? }
                       if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and
@@ -357,10 +373,10 @@ implementation
                           (tstringdef(def_from).len=tstringdef(def_to).len)) and
                          { for ansi- and unicodestrings also the encoding must match }
                          (not(tstringdef(def_from).stringtype in [st_ansistring,st_unicodestring]) or
-                          (tstringdef(def_from).encoding=tstringdef(def_to).encoding) or
+                          (tstringdef(def_from).encoding=tstringdef(def_to).encoding) //or
                           { RawByteString is compatible with everything }
-                          (tstringdef(def_from).encoding=65535) or
-                          (tstringdef(def_to).encoding=65535)) then
+                          {(tstringdef(def_from).encoding=65535) or
+                          (tstringdef(def_to).encoding=65535)}) then
                         eq:=te_equal
                      else
                        begin

compiler/ncnv.pas

@@ -1026,16 +1026,23 @@ implementation
         newblock : tblocknode;
         newstat  : tstatementnode;
         restemp  : ttempcreatenode;
+        sa : ansistring;
+        cw : WideChar;
+        l : SizeUInt;
       begin
          result:=nil;
          { we can't do widechar to ansichar conversions at compile time, since }
          { this maps all non-ascii chars to '?' -> loses information           }
 
-         if (left.nodetype=ordconstn) {and
+         if (left.nodetype=ordconstn) and
             ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
              (torddef(left.resultdef).ordtype=uchar) or
+             ((torddef(left.resultdef).ordtype=uwidechar) and
+              (current_settings.sourcecodepage<>'utf8')
+             )
+            )
              { widechar >=128 is destroyed }
-             (tordconstnode(left).value.uvalue<128))} then
+             {(tordconstnode(left).value.uvalue<128))} then
            begin
               if (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then
                begin
@@ -1051,7 +1058,19 @@ implementation
               else
                 begin
                   if (torddef(left.resultdef).ordtype=uwidechar) then
-                    hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)))
+                   begin
+                    if (current_settings.sourcecodepage<>'utf8') then
+                      hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue)))
+                    else
+                     begin
+                       exit;
+                       {Word(cw):=tcompilerwidechar(tordconstnode(left).value.uvalue);
+                       SetLength(sa,5);
+                       l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1);
+                       SetLength(sa,l-1);
+                       hp:=cstringconstnode.createstr(sa);}
+                     end
+                   end
                   else
                     hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue));
                   tstringconstnode(hp).changestringtype(resultdef);
@@ -1117,8 +1136,15 @@ implementation
       begin
         result:=nil;
         if (left.nodetype=stringconstn) and
-           (tstringdef(resultdef).stringtype in [st_ansistring,st_shortstring]) and
-           (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) then
+           //(tstringdef(resultdef).stringtype in [st_ansistring,st_shortstring]) and
+           ((tstringdef(resultdef).stringtype=st_shortstring) or
+            ((tstringdef(resultdef).stringtype=st_ansistring) and
+             (tstringdef(resultdef).encoding<>CP_NONE)
+            )
+           ) and
+           ((tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
+            (current_settings.sourcecodepage<>'utf8')
+           ) then
           begin
             tstringconstnode(left).changestringtype(resultdef);
             Result:=left;
@@ -1162,17 +1188,20 @@ implementation
     function ttypeconvnode.typecheck_char_to_char : tnode;
       var
         hp : tordconstnode;
+        cha : array[0..3] of ansichar;
+        cw : WideChar;
       begin
          result:=nil;
-         if (left.nodetype=ordconstn) 
-         {and
+         if (left.nodetype=ordconstn) and
             ((torddef(resultdef).ordtype<>uchar) or
              (torddef(left.resultdef).ordtype<>uwidechar) or
+             (current_settings.sourcecodepage<>'utf8'))
              { >= 128 is replaced by '?' currently -> loses information }
-             (tordconstnode(left).value.uvalue<128))} then
+             {(tordconstnode(left).value.uvalue<128))} then
            begin
              if (torddef(resultdef).ordtype=uchar) and
-                (torddef(left.resultdef).ordtype=uwidechar) then
+                (torddef(left.resultdef).ordtype=uwidechar) and
+                (current_settings.sourcecodepage<>'utf8') then
               begin
                 hp:=cordconstnode.create(
                       ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))),
@@ -2237,9 +2266,11 @@ implementation
               (
                 ((not is_widechararray(left.resultdef) and
                   not is_wide_or_unicode_string(left.resultdef)) or
-                 (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) {or
+                 (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) or
+                 (current_settings.sourcecodepage<>'utf8')
+                )
                  { non-ascii chars would be replaced with '?' -> loses info }
-                 not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str))})
+                 {not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)))}
               ) then
               begin
                 tstringconstnode(left).changestringtype(resultdef);

compiler/ncon.pas

@@ -1002,19 +1002,20 @@ implementation
           if (cst_type in [cst_widestring,cst_unicodestring]) and
             not(tstringdef(def).stringtype in [st_widestring,st_unicodestring]) then
             begin
-              if (tstringdef(def).encoding=CP_UTF8) then 
+              if (tstringdef(def).encoding=CP_UTF8) or
+                 (current_settings.sourcecodepage='utf8') then
                 begin
                   pw:=pcompilerwidestring(value_str);
                   l:=(getlengthwidestring(pw)*4)+1;
                   getmem(pc,l);   
                   l2:=UnicodeToUtf8(pc,l,PUnicodeChar(pw^.data),getlengthwidestring(pw));
                   if (l<>l2) then
-                    begin
-                      ReAllocMem(pc,l2);
-                      len:=l2;
-                    end;   
+                    ReAllocMem(pc,l2);
+                  len:=l2-1;
                   donewidestring(pw);
                   value_str:=pc;
+                  if (tstringdef(def).encoding<>CP_UTF8) then
+                    tstringdef(def).encoding:=CP_UTF8;
                 end
               else
                 begin

compiler/nopt.pas

@@ -25,7 +25,7 @@ unit nopt;
 
 interface
 
-uses node,nbas,nadd;
+uses node,nbas,nadd,constexp;
 
 type
   tsubnodetype = (
@@ -309,6 +309,7 @@ var
   newstatement : tstatementnode;
   tempnode    : ttempcreatenode;
   is_shortstr : boolean;
+  para : tcallparanode;
 begin
   arrp:=nil;
   hp:=p;
@@ -338,10 +339,23 @@ begin
      (aktassignmentnode.left.resultdef=p.resultdef) and
      valid_for_var(aktassignmentnode.left,false) then
     begin
-      result:=ccallnode.createintern('fpc_'+
-        tstringdef(p.resultdef).stringtypname+'_concat_multi',
-        ccallparanode.create(arrp,
-        ccallparanode.create(aktassignmentnode.left.getcopy,nil)));
+      para:=ccallparanode.create(
+              arrp,
+              ccallparanode.create(aktassignmentnode.left.getcopy,nil)
+            );
+      if is_ansistring(p.resultdef) then
+        para:=ccallparanode.create(
+                cordconstnode.create(
+                  tstringdef(p.resultdef).encoding,
+                  u16inttype,
+                  true
+                ),
+                para
+              );
+      result:=ccallnode.createintern(
+                'fpc_'+tstringdef(p.resultdef).stringtypname+'_concat_multi',
+                para
+              );
       include(aktassignmentnode.flags,nf_assign_done_in_right);
     end
   else
@@ -349,10 +363,26 @@ begin
       result:=internalstatements(newstatement);
       tempnode:=ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent ,true);
       addstatement(newstatement,tempnode);
-      addstatement(newstatement,ccallnode.createintern('fpc_'+
-        tstringdef(p.resultdef).stringtypname+'_concat_multi',
-        ccallparanode.create(arrp,
-        ccallparanode.create(ctemprefnode.create(tempnode),nil))));
+      para:=ccallparanode.create(
+              arrp,
+              ccallparanode.create(ctemprefnode.create(tempnode),nil)
+            );
+      if is_ansistring(p.resultdef) then
+        para:=ccallparanode.create(
+                cordconstnode.create(
+                  tstringdef(p.resultdef).encoding,
+                  u16inttype,
+                  true
+                ),
+                para
+              );
+      addstatement(
+        newstatement,
+        ccallnode.createintern(
+          'fpc_'+tstringdef(p.resultdef).stringtypname+'_concat_multi',
+          para
+        )
+      );
       addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
       addstatement(newstatement,ctemprefnode.create(tempnode));
     end;

compiler/pinline.pas

@@ -576,6 +576,16 @@ implementation
             { we don't need original the callparanodes tree }
             paras.free;
          end
+        else if is_ansistring(destppn.resultdef) then
+         begin
+            newblock:=ccallnode.createintern(
+              'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
+              ccallparanode.create(
+                cordconstnode.create(tstringdef(destppn.resultdef).encoding,u16inttype,true),
+                paras
+              )
+            );           
+         end
         else
          begin
             { we can reuse the supplied parameters }

compiler/ptconst.pas

@@ -908,7 +908,13 @@ implementation
                    len:=tstringconstnode(n).len;
                     case char_size of
                       1:
-                        ca:=pointer(tstringconstnode(n).value_str);
+                        begin
+                          if (tstringconstnode(n).cst_type in [cst_unicodestring,cst_widestring]) then
+                            inserttypeconv(n,cansistringtype);
+                          if n.nodetype<>stringconstn then
+                            internalerror(2010033003);
+                          ca:=pointer(tstringconstnode(n).value_str);
+                        end;
                       2:
                         begin
                           inserttypeconv(n,cwidestringtype);
@@ -942,6 +948,24 @@ implementation
                     ca:=@ch;
                     len:=1;
                   end
+               else if is_constwidecharnode(n) and (current_settings.sourcecodepage<>'utf8') then
+                  begin
+                    case char_size of
+                      1:
+                        begin
+                          inserttypeconv(n,cchartype);
+                          if not is_constcharnode(n) then
+                            internalerror(2010033001);
+                          ch[0]:=chr(tordconstnode(n).value.uvalue and $ff);
+                        end;
+                      2:
+                        widechar(ch):=widechar(tordconstnode(n).value.uvalue and $ffff);
+                      else
+                        internalerror(2010033002);
+                    end;
+                    ca:=@ch;
+                    len:=1;
+                  end
                else
                  begin
                    Message(parser_e_illegal_expression);