mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 18:30:33 +02: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/tb0245.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/ub0149.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
|
||||
#
|
||||
# 04121 is the last used one
|
||||
# 04122 is the last used one
|
||||
#
|
||||
% \section{Type checking errors}
|
||||
% 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"
|
||||
% 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.
|
||||
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}
|
||||
#
|
||||
# Symtable
|
||||
|
@ -552,6 +552,7 @@ const
|
||||
type_e_invalid_default_value=04119;
|
||||
type_e_type_not_allowed_for_type_helper=04120;
|
||||
type_e_procedure_must_be_far=04121;
|
||||
type_w_instance_abstract_class=04122;
|
||||
sym_e_id_not_found=05000;
|
||||
sym_f_internal_error_in_symtablestack=05001;
|
||||
sym_e_duplicate_id=05002;
|
||||
@ -993,9 +994,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 71922;
|
||||
MsgTxtSize = 71975;
|
||||
|
||||
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
|
||||
);
|
||||
|
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.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
|
||||
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;
|
||||
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