mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-08 14:01:52 +01:00
Add a new warning message that is generated if an instance of an abstract class is created. This message is disabled by default, but can be switched on by using {$warn 4122 on} or {$warn 4122 error}.
Please note that this warning won't be triggered if an instance of that class is created using a class variable of that class type as the compiler can not know the type contained in the variable at compile time (see also the added test).
+ msg/errore.msg: added disabled message which informs about the instantiation of an abstract class
* pexpr.pas, do_member_read: generate the message if we have a constructor call for an abstract class using a loadvmtaddrnode (thus the type name is used and not a class variable)
* msg{idx,txt}.inc: updated
+ added test
git-svn-id: trunk@28127 -
This commit is contained in:
parent
23a20f0e50
commit
a7a9440692
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -9616,6 +9616,7 @@ tests/tbf/tb0243.pp svneol=native#text/pascal
|
|||||||
tests/tbf/tb0244.pp svneol=native#text/pascal
|
tests/tbf/tb0244.pp svneol=native#text/pascal
|
||||||
tests/tbf/tb0245.pp svneol=native#text/pascal
|
tests/tbf/tb0245.pp svneol=native#text/pascal
|
||||||
tests/tbf/tb0246.pp svneol=native#text/pascal
|
tests/tbf/tb0246.pp svneol=native#text/pascal
|
||||||
|
tests/tbf/tb0247.pp svneol=native#text/pascal
|
||||||
tests/tbf/ub0115.pp svneol=native#text/plain
|
tests/tbf/ub0115.pp svneol=native#text/plain
|
||||||
tests/tbf/ub0149.pp svneol=native#text/plain
|
tests/tbf/ub0149.pp svneol=native#text/plain
|
||||||
tests/tbf/ub0158a.pp svneol=native#text/plain
|
tests/tbf/ub0158a.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -1534,7 +1534,7 @@ parser_w_ptr_type_ignored=03338_W_Pointer type "$1" ignored
|
|||||||
%
|
%
|
||||||
# Type Checking
|
# Type Checking
|
||||||
#
|
#
|
||||||
# 04121 is the last used one
|
# 04122 is the last used one
|
||||||
#
|
#
|
||||||
% \section{Type checking errors}
|
% \section{Type checking errors}
|
||||||
% This section lists all errors that can occur when type checking is
|
% This section lists all errors that can occur when type checking is
|
||||||
@ -1961,6 +1961,9 @@ type_e_type_not_allowed_for_type_helper=04120_E_Type "$1" cannot be extended by
|
|||||||
type_e_procedure_must_be_far=04121_E_Procedure or function must be far in order to allow taking its address: "$1"
|
type_e_procedure_must_be_far=04121_E_Procedure or function must be far in order to allow taking its address: "$1"
|
||||||
% In certain i8086 memory models (medium, large and huge), procedures and functions
|
% In certain i8086 memory models (medium, large and huge), procedures and functions
|
||||||
% have to be declared 'far' in order to allow their address to be taken.
|
% have to be declared 'far' in order to allow their address to be taken.
|
||||||
|
type_w_instance_abstract_class=04122_-W_Creating an instance of abstract class "$1"
|
||||||
|
% The specified class is declared as \var{abstract} and thus no instance of this class
|
||||||
|
% should be created. This is merely a warning for Delphi compatibility.
|
||||||
% \end{description}
|
% \end{description}
|
||||||
#
|
#
|
||||||
# Symtable
|
# Symtable
|
||||||
|
|||||||
@ -552,6 +552,7 @@ const
|
|||||||
type_e_invalid_default_value=04119;
|
type_e_invalid_default_value=04119;
|
||||||
type_e_type_not_allowed_for_type_helper=04120;
|
type_e_type_not_allowed_for_type_helper=04120;
|
||||||
type_e_procedure_must_be_far=04121;
|
type_e_procedure_must_be_far=04121;
|
||||||
|
type_w_instance_abstract_class=04122;
|
||||||
sym_e_id_not_found=05000;
|
sym_e_id_not_found=05000;
|
||||||
sym_f_internal_error_in_symtablestack=05001;
|
sym_f_internal_error_in_symtablestack=05001;
|
||||||
sym_e_duplicate_id=05002;
|
sym_e_duplicate_id=05002;
|
||||||
@ -993,9 +994,9 @@ const
|
|||||||
option_info=11024;
|
option_info=11024;
|
||||||
option_help_pages=11025;
|
option_help_pages=11025;
|
||||||
|
|
||||||
MsgTxtSize = 71922;
|
MsgTxtSize = 71975;
|
||||||
|
|
||||||
MsgIdxMax : array[1..20] of longint=(
|
MsgIdxMax : array[1..20] of longint=(
|
||||||
26,99,339,122,89,57,126,27,202,64,
|
26,99,339,123,89,57,126,27,202,64,
|
||||||
58,20,1,1,1,1,1,1,1,1
|
58,20,1,1,1,1,1,1,1,1
|
||||||
);
|
);
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@ -1278,6 +1278,16 @@ implementation
|
|||||||
(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
|
(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
|
||||||
(tcallnode(p1).procdefinition.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
|
(tcallnode(p1).procdefinition.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
|
||||||
Message(parser_e_java_no_inherited_constructor);
|
Message(parser_e_java_no_inherited_constructor);
|
||||||
|
{ Provide a warning if we try to create an instance of a
|
||||||
|
abstract class using the type name of that class. We
|
||||||
|
must not provide a warning if we use a "class of"
|
||||||
|
variable of that type though as we don't know the
|
||||||
|
type of the class }
|
||||||
|
if (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
|
||||||
|
(oo_is_abstract in structh.objectoptions) and
|
||||||
|
assigned(tcallnode(p1).methodpointer) and
|
||||||
|
(tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
|
||||||
|
Message1(type_w_instance_abstract_class,structh.RttiName);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
fieldvarsym:
|
fieldvarsym:
|
||||||
|
|||||||
30
tests/tbf/tb0247.pp
Normal file
30
tests/tbf/tb0247.pp
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program tb0247;
|
||||||
|
|
||||||
|
{$WARN 4122 ERROR}
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
type
|
||||||
|
TTest = class abstract
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTestClass = class of TTest;
|
||||||
|
|
||||||
|
TTestSub = class
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
o: TObject;
|
||||||
|
c: TTestClass;
|
||||||
|
begin
|
||||||
|
{ this should not create an error }
|
||||||
|
o := c.Create;
|
||||||
|
{ this neither }
|
||||||
|
o := TTestSub.Create;
|
||||||
|
{ but this should create an error }
|
||||||
|
o := TTest.Create;
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user