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

* do not allow local type definitions such as string[1] and "file of byte"

Browse Source 
inside parameter lists and function results (fixes second problem
    reported in mantis #14104, see also
    http://wiki.freepascal.org/User_Changes_Trunk#Local_type_definitions_in_parameter_lists
    )

git-svn-id: trunk@13372 -
This commit is contained in:
Jonas Maebe 2009-07-08 20:21:37 +00:00
parent 70dea05563
commit 52c6f14de5
8 changed files with 378 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/msg/errore.msg
View File

@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
#
# Parser
#
# 03251 is the last used one
# 03252 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1181,6 +1181,14 @@ parser_e_field_not_allowed_here=03251_E_Fields cannot appear after a method or p
% 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.
parser_e_no_local_para_def=03252_E_Parameters cannot contain local type definitions. Use a separate type definition in a type block.
% In Pascal, types are not considered to be identical simply because they are semantically equivalent.
% Two variables or parameters are only considered to be of the same type if they refer to the
% same type definition.
% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to
% refer to the same type definition in the procedure headers of the interface and implementation of a unit
% (both procedure headers would define a separate type). Keep in mind that expressions such as
% ``file of byte'' or ``string[50]'' also define a new type.
% \end{description}
#
# Type Checking

5
compiler/msgidx.inc
View File

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

667
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

2
compiler/pdecobj.pas
View File

@ -234,7 +234,7 @@ implementation
if try_to_consume(_LKLAMMER) then
begin
{ use single_type instead of id_type for specialize support }
single_type(hdef,false);
single_type(hdef,false,false);
if (not assigned(hdef)) or
(hdef.typ<>objectdef) then
begin

12
compiler/pdecsub.pas
View File

@ -469,7 +469,7 @@ implementation
begin
block_type:=bt_var_type;
consume(_COLON);
single_type(pv.returndef,false);
single_type(pv.returndef,false,false);
block_type:=bt_var;
end;
hdef:=pv;
@ -508,7 +508,7 @@ implementation
else
begin
{ define field type }
single_type(arrayelementdef,false);
single_type(arrayelementdef,false,false);
tarraydef(hdef).elementdef:=arrayelementdef;
end;
end
@ -521,7 +521,7 @@ implementation
else
begin
block_type:=bt_var_type;
single_type(hdef,false);
single_type(hdef,false,false);
block_type:=bt_var;
end;
@ -907,7 +907,7 @@ implementation
isclassmethod : boolean;
locationstr: string;
old_parse_generic,
popclass : boolean;
popclass : boolean;
begin
locationstr:='';
pd:=nil;
@ -947,7 +947,7 @@ implementation
popclass:=true;
parse_generic:=(df_generic in pd._class.defoptions);
end;
single_type(pd.returndef,false);
single_type(pd.returndef,false,false);
if popclass then
symtablestack.pop(pd._class.symtable);
dec(testcurobject);
@ -1091,7 +1091,7 @@ implementation
end
else
begin
single_type(pd.returndef,false);
single_type(pd.returndef,false,false);
if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
((pd.returndef.typ<>orddef) or
(torddef(pd.returndef).ordtype<>pasbool)) then

8
compiler/pdecvar.pas
View File

@ -324,11 +324,11 @@ implementation
{ define range and type of range }
hdef:=tarraydef.create(0,-1,s32inttype);
{ define field type }
single_type(arraytype,false);
single_type(arraytype,false,false);
tarraydef(hdef).elementdef:=arraytype;
end
else
single_type(hdef,false);
single_type(hdef,false,false);
end
else
hdef:=cformaltype;
@ -358,7 +358,7 @@ implementation
if (token=_COLON) or (paranr>0) or (aclass=nil) then
begin
consume(_COLON);
single_type(p.propdef,false);
single_type(p.propdef,false,false);
if (idtoken=_INDEX) then
begin
consume(_INDEX);
@ -674,7 +674,7 @@ implementation
{ Parse possible "implements" keyword }
if try_to_consume(_IMPLEMENTS) then
begin
single_type(def,false);
single_type(def,false,false);
if not(is_interface(def)) then
message(parser_e_class_implements_must_be_interface);

11
compiler/pexpr.pas
View File

@ -39,7 +39,7 @@ interface
{ reads a single factor }
function factor(getaddr : boolean) : tnode;
procedure string_dec(var def: tdef);
procedure string_dec(var def: tdef; allowtypedef: boolean);
function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
@ -87,7 +87,7 @@ implementation
{ last def found, only used by anon. inherited calls to insert proper type casts }
srdef : tdef = nil;
procedure string_dec(var def:tdef);
procedure string_dec(var def:tdef; allowtypedef: boolean);
{ reads a string type with optional length }
{ and returns a pointer to the string }
{ definition }
@ -96,8 +96,11 @@ implementation
begin
def:=cshortstringtype;
consume(_STRING);
if try_to_consume(_LECKKLAMMER) then
if (token=_LECKKLAMMER) then
begin
if not(allowtypedef) then
Message(parser_e_no_local_para_def);
consume(_LECKKLAMMER);
p:=comp_expr(true);
if not is_constintnode(p) then
begin
@ -2386,7 +2389,7 @@ implementation
_STRING :
begin
string_dec(hdef);
string_dec(hdef,true);
{ STRING can be also a type cast }
if try_to_consume(_LKLAMMER) then
begin

21
compiler/ptype.pas
View File

@ -40,7 +40,7 @@ interface
procedure id_type(var def : tdef;isforwarddef:boolean);
{ reads a string, file type or a type identifier }
procedure single_type(var def:tdef;isforwarddef:boolean);
procedure single_type(var def:tdef;isforwarddef,allowtypedef:boolean);
{ reads any type declaration, where the resulting type will get name as type identifier }
procedure read_named_type(var def:tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
@ -414,7 +414,7 @@ implementation
end;
procedure single_type(var def:tdef;isforwarddef:boolean);
procedure single_type(var def:tdef;isforwarddef,allowtypedef:boolean);
var
t2 : tdef;
dospecialize,
@ -425,14 +425,17 @@ implementation
again:=false;
case token of
_STRING:
string_dec(def);
string_dec(def,allowtypedef);
_FILE:
begin
consume(_FILE);
if try_to_consume(_OF) then
if (token=_OF) then
begin
single_type(t2,false);
if not(allowtypedef) then
Message(parser_e_no_local_para_def);
consume(_OF);
single_type(t2,false,false);
def:=tfiledef.createtyped(t2);
end
else
@ -829,7 +832,7 @@ implementation
case token of
_STRING,_FILE:
begin
single_type(def,false);
single_type(def,false,true);
end;
_LKLAMMER:
begin
@ -902,7 +905,7 @@ implementation
_CARET:
begin
consume(_CARET);
single_type(tt2,(block_type=bt_type));
single_type(tt2,(block_type=bt_type),false);
def:=tpointerdef.create(tt2);
if tt2.typ=forwarddef then
current_module.checkforwarddefs.add(def);
@ -967,7 +970,7 @@ implementation
) then
begin
consume(_OF);
single_type(hdef,(block_type=bt_type));
single_type(hdef,(block_type=bt_type),false);
if is_class(hdef) then
def:=tclassrefdef.create(hdef)
else
@ -1015,7 +1018,7 @@ implementation
if is_func then
begin
consume(_COLON);
single_type(pd.returndef,false);
single_type(pd.returndef,false,false);
end;
if token=_OF then
begin