Browse Source

Fix for bug #19975: Lower "tobjectdef.extendeddef" from "tabstractrecorddef" to "tdef" and assign "generrordef" to it if it's not a valid type to extend (the change in "pdecobj.parse_extended_type").

The other changes now take this into account and either add checks for whether the "extendeddef" is a object- or recorddef and add appropiate typecasts or lowers some local variable from "tabstractrecorddef" to "tdef" as well.

git-svn-id: branches/svenbarth/classhelpers@19281 -
svenbarth 14 years ago
parent
commit
6474e74acc
6 changed files with 32 additions and 22 deletions
  1. 3 4
      compiler/htypechk.pas
  2. 3 2
      compiler/ncal.pas
  3. 10 4
      compiler/pdecobj.pas
  4. 1 1
      compiler/pdecsub.pas
  5. 5 4
      compiler/symdef.pas
  6. 10 7
      compiler/symtable.pas

+ 3 - 4
compiler/htypechk.pas

@@ -1890,12 +1890,11 @@ implementation
                   not hasoverload then
                  break;
              end;
-           if is_objectpascal_helper(structdef) then
+           if is_objectpascal_helper(structdef) and
+              (tobjectdef(structdef).typ in [recorddef,objectdef]) then
              begin
-               if not assigned(tobjectdef(structdef).extendeddef) then
-                 Internalerror(2011062601);
                { search methods in the extended type as well }
-               srsym:=tprocsym(tobjectdef(structdef).extendeddef.symtable.FindWithHash(hashedid));
+               srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid));
                if assigned(srsym) and
                   { Delphi allows hiding a property by a procedure with the same name }
                   (srsym.typ=procsym) then

+ 3 - 2
compiler/ncal.pas

@@ -1638,7 +1638,7 @@ implementation
     function tcallnode.gen_self_tree:tnode;
       var
         selftree : tnode;
-        selfdef  : tabstractrecorddef;
+        selfdef  : tdef;
       begin
         selftree:=nil;
 
@@ -1692,7 +1692,8 @@ implementation
                 selfdef:=tobjectdef(tprocdef(procdefinition).struct).extendeddef
               else
                 selfdef:=tprocdef(procdefinition).struct;
-              if (oo_has_vmt in selfdef.objectoptions) then
+              if (selfdef.typ in [recorddef,objectdef]) and
+                  (oo_has_vmt in tabstractrecorddef(selfdef).objectoptions) then
                 begin
                   { we only need the vmt, loading self is not required and there is no
                     need to check for typen, because that will always get the

+ 10 - 4
compiler/pdecobj.pas

@@ -634,10 +634,15 @@ implementation
                         Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
                     end;
                 end;
+              else
+                hdef:=nil;
             end;
-
-            current_objectdef.extendeddef:=tabstractrecorddef(hdef);
           end;
+
+        if assigned(hdef) then
+          current_objectdef.extendeddef:=hdef
+        else
+          current_objectdef.extendeddef:=generrordef;
       end;
 
     procedure parse_guid;
@@ -1233,7 +1238,8 @@ implementation
         { if this helper is defined in the implementation section of the unit
           or inside the main project file, the extendeddefs list of the current
           module must be updated (it will be removed when poping the symtable) }
-        if is_objectpascal_helper(current_structdef) then
+        if is_objectpascal_helper(current_structdef) and
+            (current_objectdef.extendeddef.typ in [recorddef,objectdef]) then
           begin
             { the topmost symtable must be a static symtable }
             st:=current_structdef.owner;
@@ -1241,7 +1247,7 @@ implementation
               st:=st.defowner.owner;
             if st.symtabletype=staticsymtable then
               begin
-                s:=make_mangledname('',current_objectdef.extendeddef.symtable,'');
+                s:=make_mangledname('',tabstractrecorddef(current_objectdef.extendeddef).symtable,'');
                 list:=TFPObjectList(current_module.extendeddefs.Find(s));
                 if not assigned(list) then
                   begin

+ 1 - 1
compiler/pdecsub.pas

@@ -245,7 +245,7 @@ implementation
         storepos : tfileposinfo;
         vs       : tparavarsym;
         hdef     : tdef;
-        selfdef  : tabstractrecorddef;
+        selfdef  : tdef;
         vsp      : tvarspez;
         aliasvs  : tabsolutevarsym;
         sl       : tpropaccesslist;

+ 5 - 4
compiler/symdef.pas

@@ -261,7 +261,7 @@ interface
           childofderef   : tderef;
 
           { for Object Pascal helpers }
-          extendeddef   : tabstractrecorddef;
+          extendeddef   : tdef;
           extendeddefderef: tderef;
           { for C++ classes: name of the library this class is imported from }
           import_lib,
@@ -1022,9 +1022,10 @@ implementation
             if not (st.symlist[i] is ttypesym) then
               continue;
             def:=ttypesym(st.SymList[i]).typedef;
-            if is_objectpascal_helper(def) then
+            if is_objectpascal_helper(def) and
+                (tobjectdef(def).extendeddef.typ in [recorddef,objectdef]) then
               begin
-                s:=make_mangledname('',tobjectdef(def).extendeddef.symtable,'');
+                s:=make_mangledname('',tabstractrecorddef(tobjectdef(def).extendeddef).symtable,'');
                 list:=TFPObjectList(current_module.extendeddefs.Find(s));
                 if not assigned(list) then
                   begin
@@ -4660,7 +4661,7 @@ implementation
          else
            tstoredsymtable(symtable).deref;
          if objecttype=odt_helper then
-           extendeddef:=tobjectdef(extendeddefderef.resolve);
+           extendeddef:=tdef(extendeddefderef.resolve);
          for i:=0 to vmtentries.count-1 do
            begin
              vmtentry:=pvmtentry(vmtentries[i]);

+ 10 - 7
compiler/symtable.pas

@@ -2400,14 +2400,17 @@ implementation
               end;
           end;
         { now search in the extended type itself }
-        srsymtable:=classh.extendeddef.symtable;
-        srsym:=tsym(srsymtable.FindWithHash(hashedid));
-        if assigned(srsym) and
-           is_visible_for_object(srsym,contextclassh) then
+        if classh.extendeddef.typ in [recorddef,objectdef] then
           begin
-            addsymref(srsym);
-            result:=true;
-            exit;
+            srsymtable:=tabstractrecorddef(classh.extendeddef).symtable;
+            srsym:=tsym(srsymtable.FindWithHash(hashedid));
+            if assigned(srsym) and
+               is_visible_for_object(srsym,contextclassh) then
+              begin
+                addsymref(srsym);
+                result:=true;
+                exit;
+              end;
           end;
         { now search in the parent helpers }
         parentclassh:=classh.childof;