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

* give an error when trying to give a parameter of a non-simple type a

Browse Source 
default value (mantis #22343)
  * give an error when specifying an invalid default value (e.g. a
    floating point number for a longint parameter)

git-svn-id: trunk@22021 -
This commit is contained in:
Jonas Maebe 2012-08-06 20:13:20 +00:00
parent ebda98deec
commit aad3ce960a
8 changed files with 475 additions and 380 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -11766,6 +11766,9 @@ tests/webtbf/tw2174.pp svneol=native#text/plain
tests/webtbf/tw21873.pp svneol=native#text/plain
tests/webtbf/tw2209.pp svneol=native#text/plain
tests/webtbf/tw22219.pp svneol=native#text/pascal
tests/webtbf/tw22343a.pp svneol=native#text/plain
tests/webtbf/tw22343b.pp svneol=native#text/plain
tests/webtbf/tw22343c.pp svneol=native#text/plain
tests/webtbf/tw22395.pp svneol=native#text/plain
tests/webtbf/tw2242.pp svneol=native#text/plain
tests/webtbf/tw2273.pp svneol=native#text/plain

5
compiler/msg/errore.msg
View File

@ -1449,7 +1449,7 @@ parser_e_method_lower_visibility=03322_E_Overring method "$1" cannot have a lowe
% \end{description}
# Type Checking
#
# 04117 is the last used one
# 04119 is the last used one
#
% \section{Type checking errors}
% This section lists all errors that can occur when type checking is
@ -1868,6 +1868,9 @@ type_e_interface_lower_visibility=04117_E_The interface method "$1" has a higher
% code compilable for the JVM target.
type_e_typeof_requires_vmt=04118_E_TYPEOF can only be used on object types with VMT
% Typeof() intrinsic returns pointer to VMT of its argument. It cannot be used on object types that do not have VMT.
type_e_invalid_default_value=04119_E_It is not possible to define a default value for a parameter of type "$1"
% Parameters declared as structured types, such as files, variants, non-dynamic
% arrays and TP-style objects, cannot have a default value.
% \end{description}
#
# Symtable

5
compiler/msgidx.inc
View File

@ -526,6 +526,7 @@ const
type_w_interface_lower_visibility=04116;
type_e_interface_lower_visibility=04117;
type_e_typeof_requires_vmt=04118;
type_e_invalid_default_value=04119;
sym_e_id_not_found=05000;
sym_f_internal_error_in_symtablestack=05001;
sym_e_duplicate_id=05002;
@ -945,9 +946,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 66059;
MsgTxtSize = 66141;
MsgIdxMax : array[1..20] of longint=(
26,92,323,119,87,56,116,26,202,63,
26,92,323,120,87,56,116,26,202,63,
53,20,1,1,1,1,1,1,1,1
);

720
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

72
compiler/pdecsub.pas
View File

@ -233,6 +233,56 @@ implementation
explicit_paraloc,
need_array,
is_univ: boolean;
procedure handle_default_para_value;
var
convpd : tprocdef;
doconv : tconverttype;
nodetype : tnodetype;
bt : tblock_type;
begin
{ only allowed for types that can be represented by a
constant expression }
if try_to_consume(_EQ) then
begin
if (hdef.typ in [recorddef,variantdef,filedef,formaldef]) or
is_object(hdef) or
((hdef.typ=arraydef) and
not is_dynamic_array(hdef)) then
Message1(type_e_invalid_default_value,FullTypeName(hdef,nil));
vs:=tparavarsym(sc[0]);
if sc.count>1 then
Message(parser_e_default_value_only_one_para);
bt:=block_type;
block_type:=bt_const;
{ prefix 'def' to the parameter name }
defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
block_type:=bt;
if assigned(defaultvalue) then
begin
include(defaultvalue.symoptions,sp_internal);
pd.parast.insert(defaultvalue);
{ check whether the default value is of the correct
type }
if defaultvalue.consttyp in [conststring,constwstring] then
nodetype:=stringconstn
else if defaultvalue.consttyp=constnil then
nodetype:=niln
else
nodetype:=nothingn;
if compare_defs_ext(defaultvalue.constdef,hdef,nodetype,doconv,convpd,[])<=te_convert_operator then
MessagePos2(defaultvalue.fileinfo,type_e_incompatible_types,FullTypeName(defaultvalue.constdef,hdef),FullTypeName(hdef,defaultvalue.constdef));
end;
defaultrequired:=true;
end
else
begin
if defaultrequired then
Message1(parser_e_default_value_expected_for_para,vs.name);
end;
end;
begin
old_block_type:=block_type;
explicit_paraloc:=false;
@ -427,27 +477,7 @@ implementation
{ default parameter }
if (m_default_para in current_settings.modeswitches) then
begin
if try_to_consume(_EQ) then
begin
vs:=tparavarsym(sc[0]);
if sc.count>1 then
Message(parser_e_default_value_only_one_para);
{ prefix 'def' to the parameter name }
defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
if assigned(defaultvalue) then
begin
include(defaultvalue.symoptions,sp_internal);
pd.parast.insert(defaultvalue);
end;
defaultrequired:=true;
end
else
begin
if defaultrequired then
Message1(parser_e_default_value_expected_for_para,vs.name);
end;
end;
handle_default_para_value;
end;
end
else

16
tests/webtbf/tw22343a.pp Normal file
View File

@ -0,0 +1,16 @@
{ %fail }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
type
TWrapper = record end;
procedure TestProcedure(const wr: TWrapper = 0);
{ This shouldn’t be allowed; try also 0.0, '0', nil, False, reNone, etc. }
begin
end;
begin
end.

22
tests/webtbf/tw22343b.pp Normal file
View File

@ -0,0 +1,22 @@
{ %fail }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
type
TWrapper = record
class operator Implicit(value: Integer): TWrapper;
end;
class operator TWrapper.Implicit(value: Integer): TWrapper;
begin
end;
procedure TestProcedure(const wr: TWrapper = TWrapper(0));
{ This crashes the compiler, and shouldn’t be allowed }
begin
end;
begin
end.

12
tests/webtbf/tw22343c.pp Normal file
View File

@ -0,0 +1,12 @@
{ %fail }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
procedure TestProcedure(const l: longint = 1.234);
begin
end;
begin
end.