paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 09:29:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler:

Browse Source 
- 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 -
This commit is contained in:
paul 2011-09-19 04:11:57 +00:00
parent eca53485b8
commit 8b0cb2c1d5
24 changed files with 61 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
compiler/pdecl.pas
View File

@ -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

31
compiler/pexpr.pas
View File

@ -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);

3
compiler/pp.lpi
View File

@ -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>

4
rtl/inc/systemh.inc
View File

@ -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}

4
tests/test/tcpstr1.pp
View File

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

4
tests/test/tcpstr6.pp
View File

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

4
tests/test/tcpstr8.pp
View File

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

2
tests/test/tcpstransistr2shortstring.pp
View File

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

2
tests/test/tcpstransistr2widechararray.pp
View File

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

4
tests/test/tcpstransistrcompare.pp
View File

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

4
tests/test/tcpstransistrcompareequal.pp
View File

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

4
tests/test/tcpstransistrcopy.pp
View File

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

2
tests/test/tcpstrassignansistr.pp
View File

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

2
tests/test/tcpstrchar2ansistr.pp
View File

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

2
tests/test/tcpstrconcat.pp
View File

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

2
tests/test/tcpstrconcat2.pp
View File

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

6
tests/test/tcpstrconcat3.pp
View File

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

2
tests/test/tcpstrconcatmulti.pp
View File

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

6
tests/test/tcpstrconcatmulti2.pp
View File

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

4
tests/test/tcpstrpchar2ansistr.pp
View File

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

2
tests/test/tcpstrsetlength.pp
View File

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

2
tests/test/tcpstrsetlength2.pp
View File

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

4
tests/test/tcpstrshortstr2ansistr.pp
View File

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

4
tests/test/tcptypedconst.pp
View File

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