compiler:

- don't pass CP_NONE encoding to internal functions. They handled it as 0 encoding. This will optimize the generated code a bit. - convert all king of string/char/pchar constants to local ansistring def if they needs to be passed to rawbytestring type. They should not get a CP_NONE codepage (delphi compatible) - don't convert left and right arguments of string concatenation to ansistring type if they are already ansistrings but with different codepage - RTL already handles different codepages in concat routine - fix resultdef for ansistring concatenations inside assignments - return def of left assignment operand if it is already ansistring - this reduces amount of unneeded condepage conversions since concat functions can return result in any desired codepage rtl: remove CP_NONE comparisions from most of RTL functions, replace 0 constant with CP_ACP tests: add test to check various conversions to RawByteString type git-svn-id: trunk@19519 -
2025-04-09 06:08:55 +02:00 · 2011-10-20 09:25:51 +00:00 · 2011-10-20 09:25:51 +00:00 · c1866d5c17
commit c1866d5c17
parent 22f98e3259
13 changed files with 114 additions and 40 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -9979,6 +9979,7 @@ tests/test/tcpstr14.pp svneol=native#text/pascal
 tests/test/tcpstr15.pp svneol=native#text/pascal
 tests/test/tcpstr16.pp svneol=native#text/pascal
 tests/test/tcpstr17.pp svneol=native#text/pascal
+tests/test/tcpstr18.pp svneol=native#text/pascal
 tests/test/tcpstr2.pp svneol=native#text/plain
 tests/test/tcpstr2a.pp svneol=native#text/plain
 tests/test/tcpstr3.pp svneol=native#text/plain
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@ -1665,8 +1665,10 @@ implementation
                        inserttypeconv(left,rd)
                      else
                        begin
-                          inserttypeconv(left,getansistringdef);
-                          inserttypeconv(right,getansistringdef);
+                          if not is_ansistring(ld) then
+                            inserttypeconv(left,getansistringdef);
+                          if not is_ansistring(rd) then
+                            inserttypeconv(right,getansistringdef);
                        end;
                    end;
                  st_longstring :
@ -1960,6 +1962,14 @@ implementation
                    { for strings, return is always a 255 char string }
                    if is_shortstring(left.resultdef) then
                      resultdef:=cshortstringtype
+                    else
+                    { for ansistrings set resultdef to assignment left node 
+                      if it is an assignment and left node expects ansistring }
+                    if is_ansistring(left.resultdef) and
+                       assigned(aktassignmentnode) and
+                       (aktassignmentnode.right=self) and
+                       is_ansistring(aktassignmentnode.left.resultdef) then
+                      resultdef:=aktassignmentnode.left.resultdef
                    else
                      resultdef:=left.resultdef;
                  end;
@ -2047,7 +2057,7 @@ implementation
                  if is_ansistring(resultdef) then
                    para:=ccallparanode.create(
                            cordconstnode.create(
-                              tstringdef(resultdef).encoding,
+                              getparaencoding(resultdef),
                              u16inttype,
                              true
                            ),
@ -2075,7 +2085,7 @@ implementation
                  if is_ansistring(resultdef) then
                    para:=ccallparanode.create(
                            cordconstnode.create(
-                              tstringdef(resultdef).encoding,
+                              getparaencoding(resultdef),
                              u16inttype,
                              true
                            ),
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@ -938,7 +938,7 @@ implementation
                        ),
                        ccallparanode.create(
                          cordconstnode.create(
-                            tstringdef(resultdef).encoding,
+                            getparaencoding(resultdef),
                            u16inttype,
                            true
                          ),
@ -1071,7 +1071,11 @@ implementation
                   end
                  else
                    hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue));
-                  tstringconstnode(hp).changestringtype(resultdef);
+                  { output string consts in local ansistring encoding }
+                  if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0) or (tstringdef(resultdef).encoding=globals.CP_NONE)) then
+                    tstringconstnode(hp).changestringtype(getansistringdef)
+                  else
+                    tstringconstnode(hp).changestringtype(resultdef);
                end;
              result:=hp;
           end
@ -1098,7 +1102,7 @@ implementation
                   para:=ccallparanode.create(left,nil);
                   { encoding required? }
                   if tstringdef(resultdef).stringtype=st_ansistring then
-                     para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para);
+                     para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);

                   { create the procname }
                   if torddef(left.resultdef).ordtype<>uwidechar then
@ -1469,7 +1473,7 @@ implementation
          result := ccallnode.createinternres(
                      'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
                      ccallparanode.create(
-                        cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
+                        cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
                        ccallparanode.create(left,nil)
                      ),
                      resultdef
@ -1542,7 +1546,7 @@ implementation
                        'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
                         ccallparanode.create(
                           cordconstnode.create(
-                             tstringdef(resultdef).encoding,
+                             getparaencoding(resultdef),
                             u16inttype,
                             true
                           ),
@ -2291,7 +2295,7 @@ implementation
                )
              ) then
              begin
-                { convert ansistring and rawbytestring constants to explicit source encoding if set }
+                { output string consts in local ansistring encoding }
                if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0)or(tstringdef(resultdef).encoding=globals.CP_NONE)) then
                  tstringconstnode(left).changestringtype(getansistringdef)
                else
@ -3004,7 +3008,7 @@ implementation
        else if (tstringdef(resultdef).stringtype=st_ansistring) and
                (tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring,st_ansistring]) then
            result:=ccallnode.createinternres(procname,
-              ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
+              ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
              ccallparanode.create(left,nil)),resultdef)
        else
          result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);
--- a/compiler/ninl.pas
+++ b/compiler/ninl.pas
@ -325,7 +325,7 @@ implementation
        { for ansistrings insert the encoding argument }
        if is_ansistring(dest.resultdef) then
          newparas:=ccallparanode.create(cordconstnode.create(
-            tstringdef(dest.resultdef).encoding,u16inttype,true),newparas);
+            getparaencoding(dest.resultdef),u16inttype,true),newparas);

        { free the errornode we generated in the beginning }
        result.free;
@ -759,7 +759,7 @@ implementation
                  { in case of reading an ansistring pass a codepage argument }
                  if do_read and is_ansistring(para.left.resultdef) then
                    para:=ccallparanode.create(cordconstnode.create(
-                      tstringdef(para.left.resultdef).encoding,u16inttype,true),para);
+                      getparaencoding(para.left.resultdef),u16inttype,true),para);
                  { create the call statement }
                  addstatement(Tstatementnode(newstatement),
                    ccallnode.createintern(name,para));
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@ -516,6 +516,7 @@ implementation
      var
        hp : tnode;
        useshelper : boolean;
+        oldassignmentnode : tassignmentnode;
      begin
        result:=nil;
        resultdef:=voidtype;
@ -524,7 +525,14 @@ implementation
        set_unique(left);

        typecheckpass(left);
+
+        { PI. This is needed to return correct resultdef of add nodes for ansistrings
+          rawbytestring return needs to be replaced by left.resultdef }
+        oldassignmentnode:=aktassignmentnode;
+        aktassignmentnode:=self;
        typecheckpass(right);
+        aktassignmentnode:=oldassignmentnode;
+
        set_varstate(right,vs_read,[vsf_must_be_valid]);
        set_varstate(left,vs_written,[]);
        if codegenerror then
--- a/compiler/nopt.pas
+++ b/compiler/nopt.pas
@ -346,7 +346,7 @@ begin
      if is_ansistring(p.resultdef) then
        para:=ccallparanode.create(
                cordconstnode.create(
-                  tstringdef(p.resultdef).encoding,
+                  getparaencoding(p.resultdef),
                  u16inttype,
                  true
                ),
@ -370,7 +370,7 @@ begin
      if is_ansistring(p.resultdef) then
        para:=ccallparanode.create(
                cordconstnode.create(
-                  tstringdef(p.resultdef).encoding,
+                  getparaencoding(p.resultdef),
                  u16inttype,
                  true
                ),
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@ -554,7 +554,7 @@ implementation
                                  Message(parser_e_invalid_codepage);
                                  tordconstnode(p).value:=0;
                                end;
-                                tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
+                              tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
                            end;
                          p.free;
                        end;
--- a/compiler/pinline.pas
+++ b/compiler/pinline.pas
@ -581,7 +581,7 @@ implementation
            newblock:=ccallnode.createintern(
              'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
              ccallparanode.create(
-                cordconstnode.create(tstringdef(destppn.resultdef).encoding,u16inttype,true),
+                cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
                paras
              )
            );           
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@ -828,6 +828,7 @@ interface

    function getansistringcodepage:tstringencoding; inline;
    function getansistringdef:tstringdef; inline;
+    function getparaencoding(def:tdef):tstringencoding; inline;

 implementation

@ -882,6 +883,15 @@ implementation
          result:=tstringdef(cansistringtype);
      end;

+    function getparaencoding(def:tdef):tstringencoding; inline;
+      begin
+        { don't pass CP_NONE encoding to internal functions
+          they expect 0 encoding instead }
+        result:=tstringdef(def).encoding;
+        if result=CP_NONE then
+          result:=0
+      end;
+
    function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
      var
        s,hs,
--- a/rtl/inc/astrings.inc
+++ b/rtl/inc/astrings.inc
@ -203,10 +203,10 @@ Var
 begin
  { if codepages are differ then concat using unicodestring }
  S1CP:=StringCodePage(S1);
-  if (S1CP=CP_NONE) or (S1CP=0) then
+  if (S1CP=CP_ACP) then
    S1CP:=DefaultSystemCodePage;
  S2CP:=StringCodePage(S2);
-  if (S2CP=CP_NONE) or (S2CP=0) then
+  if (S2CP=CP_ACP) then
    S2CP:=DefaultSystemCodePage;
 {$ifdef FPC_HAS_CPSTRING}
  if (Pointer(DestS)=nil) then
@ -216,7 +216,7 @@ begin
 {$else FPC_HAS_CPSTRING}
  DestCP:=StringCodePage(DestS);
 {$endif FPC_HAS_CPSTRING}
-  if (DestCP=CP_NONE) or (DestCP=0) then
+  if (DestCP=CP_ACP) then
    DestCP:=DefaultSystemCodePage;
  if (S1CP<>DestCP) or (S2CP<>DestCP) then
    begin
@ -291,7 +291,7 @@ begin
 {$else FPC_HAS_CPSTRING}
  DestCP:=StringCodePage(DestS);
 {$endif FPC_HAS_CPSTRING}
-  if (DestCP=CP_NONE) or (DestCP=0) then
+  if (DestCP=CP_ACP) then
    DestCP:=DefaultSystemCodePage;
  sameCP:=true;
  lowstart:=low(sarr);
@ -308,7 +308,7 @@ begin
      U:='';
      for i:=lowstart to high(sarr) do begin
        tmpCP:=StringCodePage(sarr[i]);
-        if (tmpCP=CP_NONE) or (tmpCP=0) then
+        if (tmpCP=CP_ACP) then
          begin
            tmpStr:=sarr[i];
            SetCodePage(tmpStr,DefaultSystemCodePage,False);
@ -408,7 +408,7 @@ begin
  Size:=Length(S);
  if Size>0 then
    begin
-      if (cp=0) or (cp=CP_NONE) then
+      if (cp=CP_ACP) then
        cp:=DefaultSystemCodePage;
      orgcp:=StringCodePage(S);
      if (orgcp=cp) or (orgcp=CP_NONE) then
@ -489,7 +489,7 @@ Var
 {$endif FPC_HAS_CPSTRING}
 begin
 {$ifdef FPC_HAS_CPSTRING}
-  if (cp=0) or (cp=CP_NONE) then
+  if (cp=CP_ACP) then
    cp:=DefaultSystemCodePage;
 {$else FPC_HAS_CPSTRING}
  cp:=DefaultSystemCodePage;
@ -513,7 +513,7 @@ var
 {$endif FPC_HAS_CPSTRING}
 begin
 {$ifdef FPC_HAS_CPSTRING}
-  if (cp=0) or (cp=CP_NONE) then
+  if (cp=CP_ACP) then
    cp:=DefaultSystemCodePage;
 {$else FPC_HAS_CPSTRING}
  cp:=DefaultSystemCodePage;
@ -541,7 +541,7 @@ begin
  if L > 0 then
    begin
 {$ifdef FPC_HAS_CPSTRING}
-      if (cp=0) or (cp=CP_NONE) then
+      if (cp=CP_ACP) then
        cp:=DefaultSystemCodePage;
 {$else FPC_HAS_CPSTRING}
      cp:=DefaultSystemCodePage;
@ -576,7 +576,7 @@ begin
  if i > 0 then
    begin
 {$ifdef FPC_HAS_CPSTRING}
-      if (cp=0) or (cp=CP_NONE) then
+      if (cp=CP_ACP) then
        cp:=DefaultSystemCodePage;
 {$else FPC_HAS_CPSTRING}
      cp:=DefaultSystemCodePage;
@ -674,10 +674,10 @@ begin
  else
    begin
      r1:=S1;
-      if (cp1=CP_NONE) or (cp1=0) then
+      if (cp1=CP_ACP) then
        SetCodePage(r1,DefaultSystemCodePage,false);
      r2:=S2;
-      if (cp2=CP_NONE) or (cp2=0) then
+      if (cp2=CP_ACP) then
        SetCodePage(r2,DefaultSystemCodePage,false);
      //convert them to utf8 then compare
      SetCodePage(r1,65001);
@ -728,10 +728,10 @@ begin
  else
    begin
      r1:=S1;
-      if (cp1=CP_NONE) or (cp1=0) then
+      if (cp1=CP_ACP) then
        SetCodePage(r1,DefaultSystemCodePage,false);
      r2:=S2;
-      if (cp2=CP_NONE) or (cp2=0) then
+      if (cp2=CP_ACP) then
        SetCodePage(r2,DefaultSystemCodePage,false);
      //convert them to utf8 then compare
      SetCodePage(r1,65001);
@ -784,7 +784,7 @@ begin
         GetMem(Pointer(S),AnsiRecLen+L);
         PAnsiRec(S)^.Ref:=1;
 {$ifdef FPC_HAS_CPSTRING}
-         if (cp=0) or (cp=CP_NONE) then
+         if (cp=CP_ACP) then
           cp:=DefaultSystemCodePage;
         PAnsiRec(S)^.CodePage:=cp;
 {$else}
@ -1249,7 +1249,7 @@ begin
  Dec(Index);
  SetLength(Temp,Length(Source)+LS);
  cp:=StringCodePage(S);
-  if (cp=0) or (cp=CP_NONE) then
+  if (cp=CP_ACP) then
    cp:=DefaultSystemCodePage;
  SetCodePage(Temp,cp,false);
  If Index>0 then
--- a/rtl/inc/ustrings.inc
+++ b/rtl/inc/ustrings.inc
@ -37,7 +37,7 @@ Type
  PUnicodeRec = ^TUnicodeRec;
  TUnicodeRec = Packed Record
    CodePage    : TSystemCodePage;
-	ElementSize : Word;
+    ElementSize : Word;
 {$ifdef CPU64}	
    { align fields  }
 	Dummy       : DWord;
@ -313,7 +313,7 @@ begin
  Size:=Length(S2);
  if Size>0 then
  begin
-    if (cp=CP_NONE) or (cp=0) then
+    if (cp=CP_ACP) then
      cp:=DefaultSystemCodePage;
    widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size);
  end;
@ -333,7 +333,7 @@ begin
  if Size>0 then
  begin
    cp:=StringCodePage(S2);
-    if (cp=CP_NONE) or (cp=0) then
+    if (cp=CP_ACP) then
      cp:=DefaultSystemCodePage;
    widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size);
  end;
@ -789,7 +789,7 @@ begin
 {$ifndef FPC_HAS_CPSTRING}
  cp:=DefaultSystemCodePage;
 {$endif FPC_HAS_CPSTRING}     
-  if (cp=CP_NONE) or (cp=0) then
+  if (cp=CP_ACP) then
    cp:=DefaultSystemCodePage;
  widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
 end;
--- a/rtl/inc/wstrings.inc
+++ b/rtl/inc/wstrings.inc
@ -251,14 +251,14 @@ begin
  Size:=Length(S2);
  if Size>0 then
  begin
-    if (cp=CP_NONE) or (cp=0) then
+    if (cp=CP_ACP) then
      cp:=DefaultSystemCodePage;
    widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size);
  end;
 end;


-Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc;
+Function fpc_AnsiStr_To_WideStr(Const S2 : RawByteString): WideString; compilerproc;
 {
  Converts an AnsiString to a WideString;
 }
@ -271,7 +271,7 @@ begin
  if Size>0 then
  begin
    cp:=StringCodePage(S2);
-    if (cp=CP_NONE) or (cp=0) then
+    if (cp=CP_ACP) then
      cp:=DefaultSystemCodePage;
    widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size);
  end;
--- a/tests/test/tcpstr18.pp
+++ b/tests/test/tcpstr18.pp
@ -0,0 +1,41 @@
+// to have correct test result with delphi set codepage option to 866
+program tcpstr17;
+{$apptype console}
+{$ifdef fpc}
+  {$mode delphi}
+  {$codepage cp866}
+{$endif}
+
+{$ifdef unix}
+uses
+  cwstring;
+{$endif}
+
+procedure TestRawByte(const Source: RawByteString; cp: word; const reason: integer);
+begin
+  Writeln(StringCodePage(Source), ' ', Source);
+  if StringCodePage(Source) <> cp then
+    halt(reason);
+end;
+
+const
+  test: array[0..4] of ansichar = 'test'#0;
+var
+  s: rawbytestring;
+  ss: shortstring;
+  c: ansichar;
+  w: widechar;
+begin
+  s := 'test';
+  ss := 'test';
+  TestRawByte(s, 866, 1);
+  TestRawByte(ss, DefaultSystemCodePage, 2);
+  TestRawByte(AnsiChar('t'), 866, 3);
+  c := 't';
+  TestRawByte(c, DefaultSystemCodePage, 4);
+  TestRawByte(WideChar('t'), 866, 5);
+  w := 't';
+  TestRawByte(w, DefaultSystemCodePage, 6);
+  TestRawByte(test, DefaultSystemCodePage, 7);
+  TestRawByte(PAnsiChar(@test[0]), DefaultSystemCodePage, 8);
+end.