compiler:

- don't parse '(' token after the type declaration inside the type block
  - replace parse of "string<codepage>" to "type AnsiString(codepage)" for delphi compatibility
  - fix tests to use "type AnsiString(codepage)"

git-svn-id: trunk@19148 -

compiler/pdecl.pas

@@ -408,6 +408,7 @@ implementation
          generictypelist : TFPObjectList;
          generictokenbuf : tdynamicarray;
          vmtbuilder : TVMTBuilder;
+         p:tnode;
       begin
          old_block_type:=block_type;
          { save unit container of forward declarations -
@@ -536,6 +537,28 @@ implementation
 
                       hdef:=tstoreddef(hdef).getcopy;
 
+                      { check if it is an ansistirng(codepage) declaration }
+                      if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then
+                        begin
+                          p:=comp_expr(true,false);
+                          consume(_RKLAMMER);
+                          if not is_constintnode(p) then
+                            begin
+                              Message(parser_e_illegal_expression);
+                              { error recovery }
+                            end
+                          else
+                            begin
+                              if (tordconstnode(p).value<0) or (tordconstnode(p).value>65535) then
+                                begin
+                                  Message(parser_e_invalid_codepage);
+                                  tordconstnode(p).value:=0;
+                                end;
+                                tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
+                            end;
+                          p.free;
+                        end;
+
                       { fix name, it is used e.g. for tables }
                       if is_class_or_interface_or_dispinterface(hdef) then
                         with tobjectdef(hdef) do

compiler/pexpr.pas

@@ -130,35 +130,6 @@ implementation
               end;
              p.free;
            end
-         else if token=_LSHARPBRACKET then
-           begin
-             if not(allowtypedef) then
-               Message(parser_e_no_local_para_def);
-             consume(_LSHARPBRACKET);
-             p:=comp_expr(true,false);
-             if not is_constintnode(p) then
-               begin
-                 Message(parser_e_illegal_expression);
-                 { error recovery }
-               end
-             else
-               begin
-                 if (tordconstnode(p).value<0) or (tordconstnode(p).value>65535) then
-                   begin
-                     Message(parser_e_invalid_codepage);
-                     tordconstnode(p).value:=0;
-                   end;
-                 if tordconstnode(p).value=CP_UTF16 then
-                   def:=tstringdef.createunicode
-                 else
-                   begin
-                     def:=tstringdef.createansi;
-                     tstringdef(def).encoding:=int64(tordconstnode(p).value);
-                   end;
-                 consume(_RSHARPBRACKET);
-               end;
-             p.free;
-           end
          else
            begin
              if cs_ansistrings in current_settings.localswitches then
@@ -1522,7 +1493,7 @@ implementation
                           (token=_LT) and
                           (m_delphi in current_settings.modeswitches) then
                           generate_specialization(hdef,false,'');
-                       if try_to_consume(_LKLAMMER) then
+                       if not typeonly and try_to_consume(_LKLAMMER) then
                         begin
                           p1:=comp_expr(true,false);
                           consume(_RKLAMMER);

compiler/pp.lpi

@@ -25,7 +25,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-n -Fuc:\svn\fpcbranches\classhelpers\rtl\units\i386-win32 -Futests\test -FEtestoutput c:\svn\fpcbranches\classhelpers\tests\test\tchlp84.pp"/>
+        <CommandLineParams Value="-MObjFPC -Scgi -O1 -gl -vewnhi -l -FiD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -FuD:\programming\laz_svn\cpstr\cpstrnew\ -Fu. -FUD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -oproject1.exe D:\programming\laz_svn\fpc_features\cpstr\project1.lpr"/>
         <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -64,6 +64,7 @@
     <Linking>
       <Debugging>
         <GenerateDebugInfo Value="True"/>
+        <DebugInfoType Value="dsStabs"/>
       </Debugging>
     </Linking>
     <Other>

rtl/inc/systemh.inc

@@ -291,14 +291,14 @@ Type
   UCS4String          = array of UCS4Char;
 
 {$ifdef FPC_HAS_CPSTRING}
-  UTF8String          = String<65001>;
+  UTF8String          = type AnsiString(65001);
 {$else FPC_HAS_CPSTRING}
   UTF8String          = type ansistring;
 {$endif FPC_HAS_CPSTRING}
   PUTF8String         = ^UTF8String;
 
 {$ifdef FPC_HAS_CPSTRING}
-  RawByteString       = String<$ffff>;
+  RawByteString       = type AnsiString($ffff);
 {$else FPC_HAS_CPSTRING}
   RawByteString       = ansistring;
 {$endif FPC_HAS_CPSTRING}

tests/test/tcpstr1.pp

@@ -1,7 +1,7 @@
 {$CODEPAGE cp437}
 type
-  tcpstr437 = string<437>;
+  tcpstr437 = type AnsiString(437);
-  tcpstr850 = string<850>;
+  tcpstr850 = type AnsiString(850);
 var
   a1 : tcpstr437;
   a2 : utf8string;

tests/test/tcpstr6.pp

@@ -1,8 +1,8 @@
 {$CODEPAGE cp1251}
 // file encoding is cp1251
 type
-  Cp866String = string<866>;
+  Cp866String = type AnsiString(866);
-  Cp1251String = string<1251>;
+  Cp1251String = type AnsiString(1251);
 
 procedure WriteString(const s: RawByteString);
 begin

tests/test/tcpstr8.pp

@@ -2,8 +2,8 @@ program test;
 {$CODEPAGE UTF8}
 // file encoding is UTF8
 type
-  CP866String = string<866>;
+  CP866String = type AnsiString(866);
-  CP1251String = string<1251>;
+  CP1251String = type AnsiString(1251);
 
 procedure WriteString(const s: RawByteString);
 begin

tests/test/tcpstransistr2shortstring.pp

@@ -6,7 +6,7 @@ uses
   sysutils;
   
 type  
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstransistr2widechararray.pp

@@ -5,7 +5,7 @@
   sysutils;
   
 type  
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstransistrcompare.pp

@@ -5,8 +5,8 @@ uses
   SysUtils;
   
 type
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
-  ts1251 = type string<1251>;  
+  ts1251 = type AnsiString(1251);
 var
   a850:ts850;
   a1251 : ts1251;  

tests/test/tcpstransistrcompareequal.pp

@@ -5,8 +5,8 @@ uses
   SysUtils;
   
 type
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
-  ts1251 = type string<1251>;  
+  ts1251 = type AnsiString(1251);
 var
   a850:ts850;
   a1251 : ts1251;  

tests/test/tcpstransistrcopy.pp

@@ -5,8 +5,8 @@
   sysutils;
   
 type  
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
-  ts1252 = type string<1252>;
+  ts1252 = type AnsiString(1252);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstrassignansistr.pp

@@ -1,7 +1,7 @@
 {$CODEPAGE cp866}
 program tcpstrassignansistr;
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstrchar2ansistr.pp

@@ -5,7 +5,7 @@
   sysutils;
   
 type  
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstrconcat.pp

@@ -6,7 +6,7 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 var
   a, b, c : ts866;
 begin

tests/test/tcpstrconcat2.pp

@@ -6,7 +6,7 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 var
   a, b, c : ts866;
 begin

tests/test/tcpstrconcat3.pp

@@ -6,9 +6,9 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
-  ts1251 = type string<1251>;
+  ts1251 = type AnsiString(1251);
 var
   a : ts1251;
   b : ts850; 

tests/test/tcpstrconcatmulti.pp

@@ -7,7 +7,7 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 var
   a, b, c, d : ts866;
 begin

tests/test/tcpstrconcatmulti2.pp

@@ -7,9 +7,9 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
-  ts850 = type string<850>;
+  ts850 = type AnsiString(850);
-  ts1251 = type string<1251>;
+  ts1251 = type AnsiString(1251);
 var
   a : ts1251;
   b : ts850; 

tests/test/tcpstrpchar2ansistr.pp

@@ -5,8 +5,8 @@
   sysutils;
   
 type  
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
-  ts1252 = type string<1252>;
+  ts1252 = type AnsiString(1252);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcpstrsetlength.pp

@@ -5,7 +5,7 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 var
   a866 : ts866;
 begin

tests/test/tcpstrsetlength2.pp

@@ -5,7 +5,7 @@ uses
   SysUtils;
 
 type
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866);
 var
   a866 : ts866;
 begin

tests/test/tcpstrshortstr2ansistr.pp

@@ -6,8 +6,8 @@ uses
   sysutils;
   
 type  
-  ts866 = type string<866>;
+  ts866 = type AnsiString(866)
-  ts1252 = type string<1252>;
+  ts1252 = type AnsiString(1252);
 
   procedure doerror(ANumber : Integer);
   begin

tests/test/tcptypedconst.pp

@@ -2,8 +2,8 @@
 program tcptypedconst;
 
 type
-  Str_cp = string<1251>;
+  Str_cp = type AnsiString(1251);
-  Str_cp850 = string<850>;
+  Str_cp850 = type AnsiString(850);
   
 procedure printcontent(p : Pointer; l: integer);
 var