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

* disallow placing fields after method/property definitions, because this

Browse Source 
can create ambiguities for the parser in case the field names also exist
    as modifiers (TP- and Delphi-compatible, mantis #13971) + tests
  * fixed tests that broke because of this change

git-svn-id: trunk@13334 -
This commit is contained in:
Jonas Maebe 2009-06-27 12:59:46 +00:00
parent be43cec33a
commit c6733ed9a5
13 changed files with 393 additions and 356 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6984,6 +6984,7 @@ tests/tbf/tb0215b.pp svneol=native#text/plain
tests/tbf/tb0215c.pp svneol=native#text/plain
tests/tbf/tb0215d.pp svneol=native#text/plain
tests/tbf/tb0215e.pp svneol=native#text/plain
tests/tbf/tb0216.pp svneol=native#text/plain
tests/tbf/ub0115.pp svneol=native#text/plain
tests/tbf/ub0149.pp svneol=native#text/plain
tests/tbf/ub0158a.pp svneol=native#text/plain
@ -7099,7 +7100,6 @@ tests/tbs/tb0110.pp svneol=native#text/plain
tests/tbs/tb0111.pp svneol=native#text/plain
tests/tbs/tb0112.pp svneol=native#text/plain
tests/tbs/tb0113.pp svneol=native#text/plain
tests/tbs/tb0114.pp svneol=native#text/plain
tests/tbs/tb0115.pp svneol=native#text/plain
tests/tbs/tb0116.pp svneol=native#text/plain
tests/tbs/tb0117.pp svneol=native#text/plain

7
compiler/msg/errore.msg
View File

@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
#
# Parser
#
# 03250 is the last used one
# 03251 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1176,6 +1176,11 @@ parser_n_ignore_lower_visibility=03250_N_Virtual method "$1" has a lower visibil
% The virtual method overrides an method that is declared with a higher visibility. This might give
% unexpected results. In case the new visibility is private than it might be that a call to inherited in a
% new child class will call the higher visible method in a parent class and ignores the private method.
parser_e_field_not_allowed_here=03251_E_Fields cannot appear after a method or property definition, start a new visibility section first
% Once a method or property has been defined in a class or object, you cannot define any fields afterwards
% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is
% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers
% such as \var{default} and \var{register} also as field names.
% \end{description}
#
# Type Checking

5
compiler/msgidx.inc
View File

@ -338,6 +338,7 @@ const
parser_e_weak_external_not_supported=03248;
parser_e_forward_mismatch=03249;
parser_n_ignore_lower_visibility=03250;
parser_e_field_not_allowed_here=03251;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -787,9 +788,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 51280;
MsgTxtSize = 51385;
MsgIdxMax : array[1..20] of longint=(
24,87,251,88,65,50,108,22,202,62,
24,87,252,88,65,50,108,22,202,62,
47,20,1,1,1,1,1,1,1,1
);

685
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

18
compiler/pdecobj.pas
View File

@ -101,6 +101,11 @@ implementation
include(p.propoptions,ppo_defaultproperty);
if not(ppo_hasparameters in p.propoptions) then
message(parser_e_property_need_paras);
if (token=_COLON) then
begin
Message(parser_e_field_not_allowed_here);
consume_all_until(_SEMICOLON);
end;
consume(_SEMICOLON);
end;
{ hint directives, these can be separated by semicolons here,
@ -388,6 +393,7 @@ implementation
oldparse_only,
old_parse_generic : boolean;
object_member_blocktype : tblock_type;
fields_allowed: boolean;
begin
{ empty class declaration ? }
if (current_objectdef.objecttype=odt_class) and
@ -404,6 +410,7 @@ implementation
current_objectdef.symtable.currentvisibility:=vis_public;
testcurobject:=1;
has_destructor:=false;
fields_allowed:=true;
object_member_blocktype:=bt_general;
repeat
case token of
@ -431,6 +438,7 @@ implementation
consume(_PRIVATE);
current_objectdef.symtable.currentvisibility:=vis_private;
include(current_objectdef.objectoptions,oo_has_private);
fields_allowed:=true;
end;
_PROTECTED :
begin
@ -439,6 +447,7 @@ implementation
consume(_PROTECTED);
current_objectdef.symtable.currentvisibility:=vis_protected;
include(current_objectdef.objectoptions,oo_has_protected);
fields_allowed:=true;
end;
_PUBLIC :
begin
@ -446,6 +455,7 @@ implementation
Message(parser_e_no_access_specifier_in_interfaces);
consume(_PUBLIC);
current_objectdef.symtable.currentvisibility:=vis_public;
fields_allowed:=true;
end;
_PUBLISHED :
begin
@ -456,6 +466,7 @@ implementation
Message(parser_e_no_access_specifier_in_interfaces);
consume(_PUBLISHED);
current_objectdef.symtable.currentvisibility:=vis_published;
fields_allowed:=true;
end;
_STRICT :
begin
@ -483,6 +494,7 @@ implementation
end
else
message(parser_e_protected_or_private_expected);
fields_allowed:=true;
end;
else
begin
@ -494,6 +506,8 @@ implementation
if (current_objectdef.symtable.currentvisibility=vis_published) and
not(oo_can_have_published in current_objectdef.objectoptions) then
Message(parser_e_cant_have_published);
if (not fields_allowed) then
Message(parser_e_field_not_allowed_here);
read_record_fields([vd_object])
end
@ -505,6 +519,7 @@ implementation
_PROPERTY :
begin
property_dec;
fields_allowed:=false;
end;
_PROCEDURE,
_FUNCTION,
@ -550,6 +565,7 @@ implementation
maybe_parse_hint_directives(pd);
parse_only:=oldparse_only;
fields_allowed:=false;
end;
_CONSTRUCTOR :
begin
@ -579,6 +595,7 @@ implementation
maybe_parse_hint_directives(pd);
parse_only:=oldparse_only;
fields_allowed:=false;
end;
_DESTRUCTOR :
begin
@ -613,6 +630,7 @@ implementation
maybe_parse_hint_directives(pd);
parse_only:=oldparse_only;
fields_allowed:=false;
end;
_END :
begin

18
compiler/pdecsub.pas
View File

@ -1118,7 +1118,14 @@ implementation
message(parser_e_illegal_function_result);
{ support procedure proc stdcall export; }
if not(check_proc_directive(false)) then
consume(_SEMICOLON);
begin
if (token=_COLON) then
begin
message(parser_e_field_not_allowed_here);
consume_all_until(_SEMICOLON);
end;
consume(_SEMICOLON);
end;
result:=pd;
if locationstr<>'' then
@ -2459,7 +2466,14 @@ const
(token in [_END,_RKLAMMER,_EQUAL]) then
break
else
consume(_SEMICOLON);
begin
if (token=_COLON) then
begin
Message(parser_e_field_not_allowed_here);
consume_all_until(_SEMICOLON);
end;
consume(_SEMICOLON)
end;
end;
end
else

2
tests/tbs/tb0114.pp → tests/tbf/tb0216.pp
View File

@ -1,3 +1,5 @@
{ %fail }
{ Old file: tbs0133.pp }
{ object type declaration not 100% compatibile with TP7 }

2
tests/tbs/tb0356.pp
View File

@ -1,8 +1,8 @@
{$mode objfpc}
type
tc = class
function test(var c: tc): boolean;
left,right: tc;
function test(var c: tc): boolean;
end;
testfunc = function(var c: tc):boolean of object;

2
tests/webtbs/tw10371.pp
View File

@ -9,8 +9,8 @@ uses
type
TBug = class
protected
function InlinedMethod : longword; inline;
fL: longword;
function InlinedMethod : longword; inline;
public
procedure Method1(var Buf);
procedure Method2;

2
tests/webtbs/tw2442.pp
View File

@ -5,9 +5,9 @@ PROGRAM Procall;
TYPE
anObject =
OBJECT
n : byte;
PROCEDURE A( w : word );
PROCEDURE A( c : cardinal );
n : byte;
END
;
PROCEDURE anObject.A( w : word );

2
tests/webtbs/tw2454.pp
View File

@ -6,8 +6,8 @@ Program Test;
Type
TFunClass = Class(TObject)
Class Procedure FunProc(q : TFunClass);
data : Integer;
Class Procedure FunProc(q : TFunClass);
End;
Class Procedure TFunClass.FunProc(q : TFunClass);

2
tests/webtbs/tw7975.pp
View File

@ -7,9 +7,9 @@ interface
type
tc = class
function t(const s: string): string; virtual;
pref: string;
parent: tc;
function t(const s: string): string; virtual;
end;
function test(c: tc): string; inline;

2
tests/webtbs/tw8150a.pp
View File

@ -4,9 +4,9 @@
type
tc = class
a : longint;
class procedure classmethod;
procedure method;
a : longint;
end;
ttc = class of tc;