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

* move the check whether a subclassed type helper extends a suitable subtype of the parent's extended type to a nested procedure

Browse Source 
git-svn-id: trunk@36936 -
This commit is contained in:
svenbarth 2017-08-18 15:25:53 +00:00
parent d8ce141e2c
commit eef06e9bc6
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/pdecobj.pas
View File

@ -721,6 +721,20 @@ implementation
end;
end;
procedure check_inheritance_class_helper(var def:tdef);
begin
if (def.typ<>errordef) and assigned(current_objectdef.childof) then
begin
if not is_class(current_objectdef.childof.extendeddef) then
Internalerror(2011021101);
if not def_is_related(def,current_objectdef.childof.extendeddef) then
begin
Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
def:=generrordef;
end;
end;
end;
var
hdef: tdef;
begin
@ -753,13 +767,7 @@ implementation
begin
{ a class helper must extend the same class or a subclass
of the class extended by the parent class helper }
if assigned(current_objectdef.childof) then
begin
if not is_class(current_objectdef.childof.extendeddef) then
Internalerror(2011021101);
if not def_is_related(hdef,current_objectdef.childof.extendeddef) then
Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
end;
check_inheritance_class_helper(hdef);
end;
ht_record:
if (hdef.typ=objectdef) or