merge r14347 from cpstrnew branch by florian:

* fixed bootstrapping with 2.4.0
* patches by Graeme Geldenhuys, resolve #15251, #15252, #15253

git-svn-id: trunk@19102 -

compiler/cpid.pas

@@ -26,7 +26,7 @@ unit cpid;
   interface
 
     type
-      TEncdingEntry = record
+      TEncodingEntry = record
         id : TStringEncoding;
         name : Ansistring;
       end;

compiler/options.pas

@@ -2493,6 +2493,7 @@ begin
 {$endif}
   def_system_macro('FPC_HAS_UNICODESTRING');
   def_system_macro('FPC_RTTI_PACKSET1');
+  def_system_macro('FPC_HAS_CPSTRING');
 {$ifdef x86_64}
   def_system_macro('FPC_HAS_RIP_RELATIVE');
 {$endif x86_64}

rtl/inc/astrings.inc

@@ -51,7 +51,6 @@ Const
   AnsiRecLen = SizeOf(TAnsiRec);
   AnsiFirstOff = SizeOf(TAnsiRec)-1;
 
-
 {****************************************************************************
                     Internal functions, not in interface.
 ****************************************************************************}
@@ -353,6 +352,7 @@ begin
 end;
 {$endif EXTRAANSISHORT}
 
+{$ifdef FPC_HAS_CPSTRING}
 Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [Public, alias: 'FPC_ANSISTR_TO_ANSISTR']; compilerproc;
 {
   Converts an AnsiString to an AnsiString taking code pages into care
@@ -368,7 +368,8 @@ begin
     widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(temp)),result,cp,Size);
 end;
 
-Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR'];
+Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR'];
+{$endif FPC_HAS_CPSTRING}
 
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 
@@ -1141,9 +1142,11 @@ end;
 
 function StringCodePage(const S: RawByteString): TSystemCodePage; overload;
   begin
+{$ifdef FPC_HAS_CPSTRING}
     if assigned(Pointer(S)) then
       Result:=PAnsiRec(pointer(S)-AnsiFirstOff)^.CodePage
     else
+{$endif FPC_HAS_CPSTRING}
       Result:=DefaultSystemCodePage;
   end;
 
@@ -1172,7 +1175,12 @@ procedure SetCodePage(var s : RawByteString; CodePage : TSystemCodePage; Convert
       exit
     else if Convert then
       begin
+{$ifdef FPC_HAS_CPSTRING}
         s:=fpc_AnsiStr_To_AnsiStr(s,CodePage);
+{$else FPC_HAS_CPSTRING}
+        UniqueString(s);
+        PAnsiRec(pointer(s)-AnsiFirstOff)^.CodePage:=CodePage;
+{$endif FPC_HAS_CPSTRING}
       end
     else
       begin
@@ -1184,4 +1192,4 @@ procedure SetCodePage(var s : RawByteString; CodePage : TSystemCodePage; Convert
 procedure SetMultiByteConversionCodePage(CodePage: TSystemCodePage);
   begin
     DefaultSystemCodePage:=CodePage;
-  end;
+  end;

rtl/inc/compproc.inc

@@ -266,7 +266,9 @@ function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): s
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
+{$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_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
 
@@ -312,7 +314,7 @@ function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): s
 procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
-Function fpc_WideStr_To_AnsiStr (const S2 : WideString;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_WideStr_To_AnsiStr (const S2 : WideString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc;
 Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
 {$ifndef STR_CONCAT_PROCS}
@@ -347,7 +349,7 @@ Function  fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideSt
 {$ifndef FPC_WINLIKEWIDESTRING}
 function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
 {$endif FPC_WINLIKEWIDESTRING}
-Function fpc_WChar_To_AnsiStr(const c : WideChar;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_WChar_To_AnsiStr(const c : WideChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
 {$ifndef VER2_2}
 Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
@@ -373,7 +375,7 @@ function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeStri
 procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc;
-Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 Function fpc_AnsiStr_To_UnicodeStr (Const S2 : RawByteString): UnicodeString; compilerproc;
 Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
 Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
@@ -404,7 +406,7 @@ Function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerob
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
-Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; cp : TSystemCodePage; zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
 {$ifndef VER2_2}
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
@@ -412,7 +414,7 @@ Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased:
 {$else FPC_STRTOSHORTSTRINGPROC}
 procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
 {$endif FPC_STRTOSHORTSTRINGPROC}
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; cp : TSystemCodePage; zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
 Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
 Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
 {$ifndef FPC_STRTOCHARARRAYPROC}
@@ -441,7 +443,7 @@ 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_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
-Function fpc_UChar_To_AnsiStr(const c : UnicodeChar;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
 {$else FPC_STRTOSHORTSTRINGPROC}
@@ -451,7 +453,7 @@ procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compil
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar;cp : TSystemCodePage): ansistring; compilerproc;
+Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
 Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
@@ -464,7 +466,7 @@ procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodec
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function fpc_PWideChar_To_AnsiStr(const p : pwidechar;cp : TSystemCodePage): ansistring; compilerproc;
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$ifndef FPC_STRTOSHORTSTRINGPROC}
 Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;

rtl/inc/systemh.inc

@@ -290,10 +290,18 @@ Type
   PUCS4CharArray      = ^TUCS4CharArray;
   UCS4String          = array of UCS4Char;
 
+{$ifdef FPC_HAS_CPSTRING}
   UTF8String          = String<65001>;
+{$else FPC_HAS_CPSTRING}
+  UTF8String          = type ansistring;
+{$endif FPC_HAS_CPSTRING}
   PUTF8String         = ^UTF8String;
 
+{$ifdef FPC_HAS_CPSTRING}
   RawByteString       = String<$ffff>;
+{$else FPC_HAS_CPSTRING}
+  RawByteString       = ansistring;
+{$endif FPC_HAS_CPSTRING}
 
   HRESULT             = type Longint;
 {$ifndef FPUNONE}

rtl/inc/ustrings.inc

@@ -310,13 +310,19 @@ begin
 end;
 
 
-Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 {
   Converts a UnicodeString to an AnsiString
 }
 Var
   Size : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   result:='';
   Size:=Length(S2);
   if Size>0 then
@@ -356,10 +362,16 @@ Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compi
   end;
 
 
-Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar;cp : TSystemCodePage): ansistring; compilerproc;
+Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
 var
   Size : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   result:='';
   if p=nil then
     exit;
@@ -440,10 +452,16 @@ end;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 
 
-Function fpc_PWideChar_To_AnsiStr(const p : pwidechar;cp : TSystemCodePage): ansistring; compilerproc;
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
 var
   Size : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   result:='';
   if p=nil then
     exit;
@@ -775,11 +793,18 @@ begin
 end;
 
 
-Function fpc_UChar_To_AnsiStr(const c : UnicodeChar;cp : TSystemCodePage): AnsiString; compilerproc;
+Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
 {
   Converts a UnicodeChar to a AnsiString;
 }
+{$ifndef FPC_HAS_CPSTRING}
+var
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
 end;
 
@@ -899,10 +924,16 @@ begin
 end;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 
-Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; cp : TSystemCodePage;zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): AnsiString; compilerproc;
 var
   i  : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   if (zerobased) then
     begin
       i:=IndexWord(arr,high(arr)+1,0);
@@ -1006,10 +1037,16 @@ begin
 end;
 {$endif FPC_STRTOSHORTSTRINGPROC}
 
-Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; cp : TSystemCodePage; zerobased: boolean = true): AnsiString; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
 var
   i  : SizeInt;
+{$ifndef FPC_HAS_CPSTRING}
+  cp : TSystemCodePage;
+{$endif FPC_HAS_CPSTRING}
 begin
+{$ifndef FPC_HAS_CPSTRING}
+  cp:=$ffff;
+{$endif FPC_HAS_CPSTRING}
   if (zerobased) then
     begin
       i:=IndexWord(arr,high(arr)+1,0);
@@ -2574,9 +2611,11 @@ function StringRefCount(const S: UnicodeString): SizeInt; overload;
 
 function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
   begin
+{$ifdef FPC_HAS_CPSTRING}
     if assigned(Pointer(S)) then
       Result:=PUnicodeRec(pointer(S)-UnicodeFirstOff)^.CodePage
     else
+{$endif FPC_HAS_CPSTRING}
       Result:=DefaultUnicodeCodePage;
   end;
 

rtl/unix/cwstring.pp

@@ -175,7 +175,7 @@ begin
 end;
 {$endif}
 
-procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+procedure Wide2AnsiMove(source:pwidechar; var dest:RawByteString; cp:TSystemCodePage; len:SizeInt);
   var
     outlength,
     outoffset,
@@ -242,7 +242,7 @@ procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   end;
 
 
-procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+procedure Ansi2WideMove(source:pchar; cp:TSystemCodePage; var dest:widestring; len:SizeInt);
   var
     outlength,
     outoffset,

tests/test/README.txt

@@ -36,7 +36,7 @@ Objects ............... tobject1.pp    Fail in constructor
 Exceptions ............ texception1.pp
                         texception2.pp
                         texception3.pp
-			texception4.pp Math exceptions
+                        texception4.pp Math exceptions
 Procedure Variable .... tprocvar1.pp
                         tprocvar2.pp
 Libraries ............. testlib.pp     a very primitive test
@@ -52,8 +52,8 @@ case .................. tcase1.pp      tests case statements with byte and word
                         tcase2.pp      tests case with sub enum types
 Arrays ................ tarray1.pp     open arrays with classes
                         tarray2.pp     Array of const
-			tarray3.pp     Array of Char #1 (Known bug)
-			tarray4.pp     Array of Char #2 (Known bug)
+                        tarray3.pp     Array of Char #1 (Known bug)
+                        tarray4.pp     Array of Char #2 (Known bug)
 Enumerations .......... tenum1.pp      tests assignments of subrange
                                        enumerations
 Codegenerration ....... tcg1.pp        i386 pushw
@@ -63,8 +63,8 @@ Inline ................ tinline1.pp    tests recursive inlining, inlining
                                        a procedure multiple times and
                                        inlining procedures in other
                                        inline procedures.
-			tinlin64.pp    tests for a problem in pushing 64bit parameters
-				       by value.	
+                        tinlin64.pp    tests for a problem in pushing 64bit parameters
+                                       by value.
 TypeInfo .............. trtti2.pp      test the function system.typeinfo
                         trtti3.pp      tests the procedure system.finalize
 Resourcestrings ....... tresstr.pp     tests a simple resource string
@@ -82,6 +82,10 @@ Assembler readers...... tasmread.pp    tests for support of unit or program spec
 Variants............... tvariant.pp    tests the variant support of FPC
                         tasout.pp      tests a problem if a unit is compiled with nasm
 
+Code Page strings       tpcstr1.pp     tests the new codepage string type introduced
+                         ...           in the 'cpstrnew' branch.
+                        tcpstrXX.pp
+
 --------------------------------------------------------------------
                             RTL
 --------------------------------------------------------------------