merge r17601 from cpstrnew branch by inoussa:

Correct fpc_ansistr_to_ansistr and fpc_short_to_ansistr and test

git-svn-id: trunk@19121 -

.gitattributes

@@ -9955,6 +9955,7 @@ tests/test/tcpstrconcatmulti.pp svneol=native#text/plain
 tests/test/tcpstrconcatmulti2.pp svneol=native#text/plain
 tests/test/tcpstrsetlength.pp svneol=native#text/plain
 tests/test/tcpstrsetlength2.pp svneol=native#text/plain
+tests/test/tcpstrshortstr2ansistr.pp svneol=native#text/plain
 tests/test/tcptypedconst.pp svneol=native#text/plain
 tests/test/tcptypedconst2.pp svneol=native#text/plain
 tests/test/tcptypedconst3.pp svneol=native#text/plain

compiler/ncnv.pas

@@ -2979,7 +2979,7 @@ implementation
           end
         { encoding parameter required? }
         else if (tstringdef(resultdef).stringtype=st_ansistring) and
-            ((tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring]) or
+            ((tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring]) or
              { ansistring to ansistring and no RawByteString envolved? }
              (//(tstringdef(resultdef).encoding<>65535) and
               (tstringdef(left.resultdef).stringtype=st_ansistring) 

rtl/inc/astrings.inc

@@ -426,7 +426,7 @@ begin
         begin
           SetLength(result,Size);
           Move(S[1],result[1],Size);
-          PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=cp;
+          PAnsiRec(Pointer(result)-AnsiFirstOff)^.CodePage:=cp;
         end
       else
         begin
@@ -489,17 +489,29 @@ end;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 
 
-Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
+Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
 {
   Converts a ShortString to a AnsiString;
 }
 Var
   Size : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifdef FPC_HAS_CPSTRING}
+  if (cp=0) then
+    cp:=DefaultSystemCodePage;
+{$else FPC_HAS_CPSTRING}
+  cp:=DefaultSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
   Size:=Length(S2);
   Setlength (fpc_ShortStr_To_AnsiStr,Size);
   if Size>0 then
-    Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
+    begin
+      Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
+      SetCodePage(fpc_ShortStr_To_AnsiStr,cp,False);
+    end
 end;
 
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;

rtl/inc/compproc.inc

@@ -269,7 +269,7 @@ procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring);
 {$ifdef FPC_HAS_CPSTRING}
 Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc;
 {$endif FPC_HAS_CPSTRING}
-Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
+Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
 Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 
 Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;

tests/test/tcpstrshortstr2ansistr.pp

@@ -0,0 +1,49 @@
+{$mode objfpc} {$H+}
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  sysutils;
+  
+type  
+  ts866 = type string<866>;
+  ts1252 = type string<1252>;
+
+  procedure doerror(ANumber : Integer);
+  begin
+    WriteLn('error ',ANumber);
+    Halt(ANumber);
+  end;
+
+var
+  s : ts866;
+  x : ts1252;
+  ss : shortstring;
+  i : Integer;
+begin
+  ss := #128#156#196;
+
+  s := ss;
+  if (StringCodePage(s) <> 866) then
+    doerror(1);
+  if (Length(s) <> Length(ss)) then
+    doerror(2);
+  for i := 1 to Length(s) do
+    begin
+      if (Byte(s[i]) <> Byte(ss[i])) then
+        doerror(3)
+    end;
+
+  x := ss;
+  if (StringCodePage(x) <> 1252) then
+    doerror(4);
+  if (Length(x) <> Length(ss)) then
+    doerror(5);
+  for i := 1 to Length(x) do
+    begin
+      if (Byte(x[i]) <> Byte(ss[i])) then
+        doerror(6)
+    end;
+
+  WriteLn('Ok');
+end.