浏览代码

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

git-svn-id: trunk@36936 -
svenbarth 8 年之前
父节点
当前提交
eef06e9bc6
共有 1 个文件被更改,包括 15 次插入7 次删除
  1. 15 7
      compiler/pdecobj.pas

+ 15 - 7
compiler/pdecobj.pas

@@ -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