View Issue Details

IDProjectCategoryView StatusLast Update
0037953FPCCompilerpublic2020-10-19 13:12
ReporterAndrewH Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionwon't fix 
Product Version3.3.1 
Summary0037953: [PATCH] Using a forward declared subtype is incompatible with a typed generic declaration.
DescriptionTA = class; // forward
TB = class; // forward TB = class(TA)

TBaseAList<T: TA> = class // no problems using forward declared TA
end;

TAList = class(TBaseAList<TA>); // no problem
TBList = class(TBaseAList<TB>); // message: expected TA got TB!

TA = class
end;

TB = class(TA)
end;

The attached patch makes this work. I'm not sure how Delphi behaves as I don't have it.

Steps To Reproduceprogram Project1;

{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}

type
  TA = class; // forward
  TB = class; // forward TB = class(TA)
  //TC = class; // forward

  TBaseAList<T: TA> = class // no problems
    Foo: T;
  end;

  TAList = class(TBaseAList<TA>); // no problem
  TBList = class(TBaseAList<TB>); // message: expected TA got TB!
  //TCList = class(TBaseAList<TC>); // indicates that TC should inherit from TA

  TA = class
  end;

  TB = class(TA)
  end;

  //TC = class(TObject); // not related to TA and should always fail.

begin
end.
        
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget-
Attached Files

Activities

AndrewH

2020-10-18 18:39

developer   ~0126399

generic_forward.patch (5,065 bytes)   
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index b490cd18f3..c71a1989f3 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -686,6 +686,14 @@ implementation
               current_objectdef.set_parent(childof)
             else
               Message1(sym_e_formal_class_not_resolved,childof.objrealname^);
+
+            { if forward_must_inherit_from is defined then a generic object
+              refered to a forward type and the declaration must inherit from
+              that!
+            }
+            if Assigned(current_objectdef.forward_must_inherit_from)
+               and not def_is_related(childof, current_objectdef.forward_must_inherit_from) then
+                 Message2(type_e_incompatible_types, childof.typename, current_objectdef.forward_must_inherit_from.typename);
           end;
 
         if hasparentdefined then
diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas
index 56567d6cff..7b210abe0f 100644
--- a/compiler/pgenutil.pas
+++ b/compiler/pgenutil.pas
@@ -428,8 +428,14 @@ uses
                             if assigned(formalobjdef.childof) and
                                 not def_is_related(paradef,formalobjdef.childof) then
                               begin
-                                MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
-                                result:=false;
+                                if (Assigned(paraobjdef) and (oo_is_forward in paraobjdef.objectoptions)) then
+                                  begin
+                                    paraobjdef.set_forward_must_inherit(formalobjdef.childof);
+                                  end
+                                  else begin
+                                    MessagePos2(filepos,type_e_incompatible_types,':D'+paraobjdef.typename,formalobjdef.childof.typename);
+                                    result:=false;
+                                  end;
                               end;
                             intfcount:=0;
                             for j:=0 to formalobjdef.implementedinterfaces.count-1 do
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 67fee52ff0..7cef0b718c 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -487,6 +487,11 @@ interface
           }
           classref_created_in_current_module : boolean;
           objecttype     : tobjecttyp;
+          {
+            the object type this must inherit from. if null then no requirement.
+            otherwise we expect this to inherit from this object type.
+          }
+          forward_must_inherit_from: tobjectdef;
           constructor create(ot:tobjecttyp;const n:string;c:tobjectdef;doregister:boolean);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -518,6 +523,7 @@ interface
           procedure insertvmt;
           function  vmt_offset: asizeint;
           procedure set_parent(c : tobjectdef);
+          procedure set_forward_must_inherit(parent: tobjectdef);
           function find_destructor: tprocdef;
           function implements_any_interfaces: boolean;
           { dispinterface support }
@@ -7784,6 +7790,52 @@ implementation
           end;
       end;
 
+   procedure tobjectdef.set_forward_must_inherit(parent: tobjectdef);
+        function ischildof(curr,checking: tobjectdef): boolean;
+        var
+          i: tobjectdef;
+        begin
+          result := false;
+          i := checking;
+          while Assigned(i) and not result do
+            begin
+              if i = curr then
+                result := true;
+              // check if it's an as yet unresolved forward type
+              if not Assigned(i.childof) and Assigned(i.forward_must_inherit_from) then
+                i := i.forward_must_inherit_from
+              else
+                i := i.childof;
+            end;
+        end;
+
+     begin
+       if parent = nil then
+         Internalerror(2020101701);
+       if parent.typ in [objectdef] then
+         begin
+           if not Assigned(forward_must_inherit_from) then
+             forward_must_inherit_from := parent
+           else
+           begin
+             if ischildof(forward_must_inherit_from, parent) then
+             begin
+               // use a more specific subclass that is still a subclass of the
+               // existing forward_must_inherit_from value
+               forward_must_inherit_from := parent
+             end
+             else if ischildof(parent, forward_must_inherit_from) then
+             begin
+               // parent already an ancestor of forward_must_inherit_from
+             end
+             else begin
+               // we have multiple but incompatible inheritance definitions
+               Message2(type_e_incompatible_types,
+                  fulltypename,forward_must_inherit_from.fulltypename);
+             end;
+           end;
+         end;
+     end;
 
    procedure tobjectdef.insertvmt;
      begin
generic_forward.patch (5,065 bytes)   

Sven Barth

2020-10-19 13:12

manager   ~0126414

The compiler does not know that TB will indeed fullfill the constraint, thus such a construct is definitely not allowed.

Issue History

Date Modified Username Field Change
2020-10-18 17:53 AndrewH New Issue
2020-10-18 17:53 AndrewH File Added: generic_forward.patch
2020-10-18 18:16 AndrewH File Deleted: generic_forward.patch
2020-10-18 18:39 AndrewH Note Added: 0126399
2020-10-18 18:39 AndrewH File Added: generic_forward.patch
2020-10-19 13:12 Sven Barth Assigned To => Sven Barth
2020-10-19 13:12 Sven Barth Status new => resolved
2020-10-19 13:12 Sven Barth Resolution open => won't fix
2020-10-19 13:12 Sven Barth FPCTarget => -
2020-10-19 13:12 Sven Barth Note Added: 0126414