* record/use the code page of string constants typecasted to an ansistring

    type with a non-default code page
   TODO: ensure that string constants typecasted to ansistring become
     ansistrings rather than typeless string constants

git-svn-id: trunk@25207 -

.gitattributes

@@ -10969,6 +10969,7 @@ tests/test/tcpstr21.pp svneol=native#text/pascal
 tests/test/tcpstr21a.pp svneol=native#text/pascal
 tests/test/tcpstr22.pp svneol=native#text/pascal
 tests/test/tcpstr23.pp svneol=native#text/pascal
+tests/test/tcpstr24.pp svneol=native#text/plain
 tests/test/tcpstr2a.pp svneol=native#text/plain
 tests/test/tcpstr3.pp svneol=native#text/plain
 tests/test/tcpstr4.pp svneol=native#text/plain

compiler/nadd.pas

@@ -756,7 +756,7 @@ implementation
              case nodetype of
                 addn :
                   begin
-                    t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
+                    t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,nil);
                     typecheckpass(t);
                     tstringconstnode(t).changestringtype(resultdef);
                   end;

compiler/ncnv.pas

@@ -1048,7 +1048,7 @@ implementation
                    begin
                      pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
                      left.free;
-                     left:=cstringconstnode.createpchar(pchtemp,arrsize);
+                     left:=cstringconstnode.createpchar(pchtemp,arrsize,nil);
                      typecheckpass(left);
                    end;
                  exit;

compiler/ncon.pas

@@ -121,9 +121,11 @@ interface
           value_str : pchar;
           len     : longint;
           lab_str : tasmlabel;
+          astringdef : tdef;
+          astringdefderef : tderef;
           cst_type : tconststringtype;
           constructor createstr(const s : string);virtual;
-          constructor createpchar(s : pchar;l : longint);virtual;
+          constructor createpchar(s: pchar; l: longint; def: tdef);virtual;
           constructor createunistr(w : pcompilerwidestring);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -309,7 +311,7 @@ implementation
               getmem(pc,len+1);
               move(pchar(p.value.valueptr)^,pc^,len);
               pc[len]:=#0;
-              p1:=cstringconstnode.createpchar(pc,len);
+              p1:=cstringconstnode.createpchar(pc,len,p.constdef);
             end;
           constwstring :
             p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
@@ -827,12 +829,19 @@ implementation
       end;
 
 
-    constructor tstringconstnode.createpchar(s : pchar;l : longint);
+    constructor tstringconstnode.createpchar(s: pchar; l: longint; def: tdef);
       begin
          inherited create(stringconstn);
          len:=l;
          value_str:=s;
-         cst_type:=cst_conststring;
+         if assigned(def) and
+            is_ansistring(def) then
+           begin
+             cst_type:=cst_ansistring;
+             astringdef:=def;
+           end
+         else
+           cst_type:=cst_conststring;
          lab_str:=nil;
       end;
 
@@ -880,6 +889,8 @@ implementation
             value_str[len]:=#0;
           end;
         lab_str:=tasmlabel(ppufile.getasmsymbol);
+        if cst_type=cst_ansistring then
+          ppufile.getderef(astringdefderef);
       end;
 
 
@@ -893,18 +904,22 @@ implementation
         else
           ppufile.putdata(value_str^,len);
         ppufile.putasmsymbol(lab_str);
+        if cst_type=cst_ansistring then
+          ppufile.putderef(astringdefderef);
       end;
 
 
     procedure tstringconstnode.buildderefimpl;
       begin
         inherited buildderefimpl;
+        astringdefderef.build(astringdef);
       end;
 
 
     procedure tstringconstnode.derefimpl;
       begin
         inherited derefimpl;
+        astringdef:=tdef(astringdefderef.resolve);
       end;
 
 
@@ -925,6 +940,7 @@ implementation
            end
          else
            n.value_str:=getpcharcopy;
+         n.astringdef:=astringdef;
          dogetcopy:=n;
       end;
 
@@ -948,7 +964,10 @@ implementation
           cst_shortstring :
             resultdef:=cshortstringtype;
           cst_ansistring :
-            resultdef:=getansistringdef;
+            if not assigned(astringdef) then
+              resultdef:=getansistringdef
+            else
+              resultdef:=astringdef;
           cst_unicodestring :
             resultdef:=cunicodestringtype;
           cst_widestring :

compiler/ninl.pas

@@ -2537,7 +2537,7 @@ implementation
           encodedtype:='';
           if not objctryencodetype(left.resultdef,encodedtype,errordef) then
             Message1(type_e_objc_type_unsupported,errordef.typename);
-          result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype));
+          result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
         end;
 
 

compiler/pdecl.pas

@@ -109,7 +109,13 @@ implementation
                  begin
                    getmem(sp,tstringconstnode(p).len+1);
                    move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
-                   hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len);
+                   { if a non-default ansistring code page has been specified,
+                     keep it }
+                   if is_ansistring(p.resultdef) and
+                      (tstringdef(p.resultdef).encoding<>0) then
+                     hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len,p.resultdef)
+                   else
+                     hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len,nil);
                  end;
              end;
            realconstn :
@@ -942,7 +948,7 @@ implementation
                                 getmem(sp,2);
                                 sp[0]:=chr(tordconstnode(p).value.svalue);
                                 sp[1]:=#0;
-                                sym:=tconstsym.create_string(orgname,constresourcestring,sp,1);
+                                sym:=tconstsym.create_string(orgname,constresourcestring,sp,1,nil);
                              end
                            else
                              Message(parser_e_illegal_expression);
@@ -952,7 +958,7 @@ implementation
                           begin
                              getmem(sp,len+1);
                              move(value_str^,sp^,len+1);
-                             sym:=tconstsym.create_string(orgname,constresourcestring,sp,len);
+                             sym:=tconstsym.create_string(orgname,constresourcestring,sp,len,nil);
                           end;
                       else
                         Message(parser_e_illegal_expression);

compiler/pexpr.pas

@@ -3112,7 +3112,7 @@ implementation
 
              _CSTRING :
                begin
-                 p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
+                 p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern),nil);
                  consume(_CSTRING);
                  if token in postfixoperator_tokens then
                    begin

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 161;
+  CurrentPPUVersion = 162;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/symsym.pas

@@ -312,7 +312,7 @@ interface
           constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
           constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
           constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
-          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
+          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);
           constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -2149,13 +2149,16 @@ implementation
       end;
 
 
-    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
+    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def: tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
          consttyp:=t;
          value.valueptr:=str;
-         constdef:=getarraydef(cansichartype,l);
+         if assigned(def) then
+           constdef:=def
+         else
+           constdef:=getarraydef(cansichartype,l);
          value.len:=l;
       end;
 

tests/test/tcpstr24.pp

@@ -0,0 +1,28 @@
+{$codepage utf8}
+
+
+type
+  str866 = type ansistring(866);
+const
+  x = utf8string('abcdef');
+  y = utf8string('®†◊√');
+  z = str866('abc');
+
+procedure test(const x: shortstring);
+begin
+  writeln('shortstring!');
+  halt(1);
+end;
+
+procedure test(const x: rawbytestring; cp: tsystemcodepage);
+begin
+  writeln('ansistring(',stringcodepage(x),')');
+  if stringcodepage(x)<>cp then
+    halt(2);
+end;
+
+begin
+  test(x,CP_UTF8);
+  test(y,CP_UTF8);
+  test(z,866);
+end.