View Issue Details

IDProjectCategoryView StatusLast Update
0020854FPCCompilerpublic2018-02-08 18:17
ReporterMarco van de VoortAssigned ToSven Barth 
PrioritynormalSeverityfeatureReproducibilityhave not tried
Status closedResolutionfixed 
Product VersionProduct Build 
Target VersionFixed in Version3.0.0 
Summary0020854: Generic constraints
DescriptionDelphi allows to specify constraints with generics.

type xx<t:constraint1,constraint2> = class ...

Constraints can be classtypes, interfacetypes and special cases "class","record" and "constructor", separated with comma's like interfaces.

Constructor means that the class has a constructor without parameters, and allows generic code to call a constructor on a type T.

Class means that it is a reference type (class or interface), probably important for typecasting relating to inheritance.

record means it is a value type
Tagsgenerics
Fixed in Revision23158
FPCOldBugId0
FPCTarget
Attached Files
  • basepool.pas (3,195 bytes)
    unit basepool;
    // (C) Candela 2009.  Released under GPLv2.
    // works with D2009 and DXE. Compile with testpool to also test object creation.
    
    interface
    {$ifdef fpc}{$mode delphi}{$endif}
    
    Uses Classes;
    
    Type
        TBaseFactory<t:class,constructor>  = class
                          function getobject:T; virtual; abstract;
                          procedure resetobject(obj:T); virtual; abstract;
       end;
    
    
       TGenPool <T:class,constructor> = class
                                          factory : TBaseFactory<t>;
                                          function    getitem:T; virtual; abstract;
                                          procedure   putitem(b:T); overload; virtual; abstract;
                                          constructor create; virtual;
       end;
    
       TLockedPool<T:class,constructor>   =   class(TGenPool<t>)
                                           private
                                            lst : tthreadlist;
                                            public
                                            destructor  destroy; override;
                                            constructor create; override;
                                            function    getitem:T;override;
                                            procedure   putitem(b:T);override;
                                          end;
    
     
    
    {$ifdef testpool}
       TOverlayPool = Class(TLockedPool<TStringList>);
       TOverlayFactory= class(TBaseFactory<TStringList>)
                          function getobject:TStringList; override;
       end;
    {$endif}
     
    implementation
    
    Uses SysUtils;
    
    { TGenPool<T> }
    
    constructor TGenPool<T>.Create;
    
    begin
    
    end;
    
    { TLockedPool<T> }
    
    constructor TLockedPool<T>.create;
    begin
      lst:=TThreadlist.Create;
    end;
    
    destructor TLockedPool<T>.destroy;
    var i : integer;
      v: tlist;
    begin
      v:=lst.locklist;
      for i:=0 to v.count-1 do
        Tobject(v[i]).Free;
      lst.unlocklist;
      v.clear;
      freeandnil(lst);
      inherited;
    end;
    
    function TLockedPool<T>.getitem: T;
    var cnt:integer;
        v : tlist;
    begin
      v:=lst.LockList;
      cnt:=v.Count;
      if cnt>0 then
        begin
          ppointer(@result)^:=tobject(v[cnt-1]);
          v.delete(cnt-1);
          factory.resetobject(result);
        end
      else
        begin
          result:=factory.getobject;
        end;
      lst.UnlockList;
    end;
    
    procedure TLockedPool<T>.putitem(b: T);
    // http://stackoverflow.com/questions/3889335/generic-locked-pool-adding-generic-to-non-generic-tlist
    var  v : Tlist;
    begin
     if assigned(b) then
        begin
              v:=lst.LockList;
              v.Add(ppointer(@b)^); // workaround for D2009 bug?
              lst.unlocklist;
        end;
      b:=nil;
    end;
    
    {$ifdef testpool}
    function TOverlayFactory.getobject:TStringList;
    begin
      result:=nil;
    end;
    
    
    procedure test;
    var n : TOverlayPool;
        x : TOverlayFactory;
    begin
       n:=TOverLayPool.Create;
       x:=TOverlayFactory.Create; // will warn that abstract methods are not implemented.
       n.factory:=x;              // which is ok, since it is this assignment that the test is for, mainly.
                                  // IIRC related to the special constraints.
    end;
    
    initialization
     test;
    {$endif}
    
     
    end.
    
    basepool.pas (3,195 bytes)

Relationships

related to 0019491 resolvedJonas Maebe A lot of Generics' implementations 

Activities

2011-12-09 10:50

 

basepool.pas (3,195 bytes)
unit basepool;
// (C) Candela 2009.  Released under GPLv2.
// works with D2009 and DXE. Compile with testpool to also test object creation.

interface
{$ifdef fpc}{$mode delphi}{$endif}

Uses Classes;

Type
    TBaseFactory<t:class,constructor>  = class
                      function getobject:T; virtual; abstract;
                      procedure resetobject(obj:T); virtual; abstract;
   end;


   TGenPool <T:class,constructor> = class
                                      factory : TBaseFactory<t>;
                                      function    getitem:T; virtual; abstract;
                                      procedure   putitem(b:T); overload; virtual; abstract;
                                      constructor create; virtual;
   end;

   TLockedPool<T:class,constructor>   =   class(TGenPool<t>)
                                       private
                                        lst : tthreadlist;
                                        public
                                        destructor  destroy; override;
                                        constructor create; override;
                                        function    getitem:T;override;
                                        procedure   putitem(b:T);override;
                                      end;

 

{$ifdef testpool}
   TOverlayPool = Class(TLockedPool<TStringList>);
   TOverlayFactory= class(TBaseFactory<TStringList>)
                      function getobject:TStringList; override;
   end;
{$endif}
 
implementation

Uses SysUtils;

{ TGenPool<T> }

constructor TGenPool<T>.Create;

begin

end;

{ TLockedPool<T> }

constructor TLockedPool<T>.create;
begin
  lst:=TThreadlist.Create;
end;

destructor TLockedPool<T>.destroy;
var i : integer;
  v: tlist;
begin
  v:=lst.locklist;
  for i:=0 to v.count-1 do
    Tobject(v[i]).Free;
  lst.unlocklist;
  v.clear;
  freeandnil(lst);
  inherited;
end;

function TLockedPool<T>.getitem: T;
var cnt:integer;
    v : tlist;
begin
  v:=lst.LockList;
  cnt:=v.Count;
  if cnt>0 then
    begin
      ppointer(@result)^:=tobject(v[cnt-1]);
      v.delete(cnt-1);
      factory.resetobject(result);
    end
  else
    begin
      result:=factory.getobject;
    end;
  lst.UnlockList;
end;

procedure TLockedPool<T>.putitem(b: T);
// http://stackoverflow.com/questions/3889335/generic-locked-pool-adding-generic-to-non-generic-tlist
var  v : Tlist;
begin
 if assigned(b) then
    begin
          v:=lst.LockList;
          v.Add(ppointer(@b)^); // workaround for D2009 bug?
          lst.unlocklist;
    end;
  b:=nil;
end;

{$ifdef testpool}
function TOverlayFactory.getobject:TStringList;
begin
  result:=nil;
end;


procedure test;
var n : TOverlayPool;
    x : TOverlayFactory;
begin
   n:=TOverLayPool.Create;
   x:=TOverlayFactory.Create; // will warn that abstract methods are not implemented.
   n.factory:=x;              // which is ok, since it is this assignment that the test is for, mainly.
                              // IIRC related to the special constraints.
end;

initialization
 test;
{$endif}

 
end.
basepool.pas (3,195 bytes)

Sven Barth

2011-12-09 14:08

manager   ~0054865

Constraints are already on my ToDo list. I just don't know whether I first implement constraints or generic functions :)

Regards,
Sven

Marco van de Voort

2011-12-09 14:58

manager   ~0054870

Since I don't use generic functions yet, I vote for constraints :-)

Though the images bit (from which the alias bugreports are extracted) is more important to me than this pool stuff.

Alexander Shishkin

2011-12-09 23:53

reporter   ~0054880

I think that generic functions are more priority. Delphi code with constrains can be compiled with FPC using ifdefs around them, and will work as expected (!) But I have no idea now to make code with generic functions portable to fpc without being fully rewritten.

Anthony Walter

2012-05-13 00:14

reporter   ~0059544

Adding constraints won't improve functionality.

Constraints would be nice, but the way FPC handles generics in some ways is much superior to the current Delphi implementation or even the C# implementation, in my opinion.

I think the way FPC generics work now is like C++ templates, which are code generators. The generated code is checked against the types at compile time allowing us to write something like:

function TMyClass<T>.Add(const A, B: T): T;
begin
  Result := A + B;
end;

The above is not possible in Delphi or C#, but the above is HIGHLY desirable. It's exactly because the code above won't work in Delphi or C# why those languages have generic constraints. The constraints relax those compilers to allow call specific methods of T to be invoked. But currently FPC generics will figure it methods of T exist at compile time without the need for constraints and this is a good thing.

As such, the only reason I see to add constraints is to make FPC code more compatible with Delphi.

Sven Barth

2012-05-14 12:49

manager   ~0059578

Constraints are useful if you have certain expectations about the type. Consider FPC's TFPGObjectList. Currently you can specialize it using every type, but once constraints are added the declaration can be changed to "TFPGObjectList<T: class> = class ... end;" so that it is clear that only descendants of TObject can be used for a specialization (the compiler will enforce this). This also allows the compiler to do more checks while parsing the generic instead of when specializing.

Regards,
Sven

Sven Barth

2012-12-16 15:11

manager   ~0064334

Please test and close if okay.

Regards,
Sven

Issue History

Date Modified Username Field Change
2011-12-09 10:50 Marco van de Voort New Issue
2011-12-09 10:50 Marco van de Voort File Added: basepool.pas
2011-12-09 10:50 Marco van de Voort FPCOldBugId => 0
2011-12-09 14:08 Sven Barth Note Added: 0054865
2011-12-09 14:58 Marco van de Voort Note Added: 0054870
2011-12-09 22:43 Florian Severity minor => feature
2011-12-09 23:53 Alexander Shishkin Note Added: 0054880
2011-12-11 11:48 Paul Ishenin Tag Attached: generics
2012-05-09 16:44 Marco van de Voort Description Updated
2012-05-13 00:14 Anthony Walter Note Added: 0059544
2012-05-14 12:49 Sven Barth Note Added: 0059578
2012-06-01 14:14 Sven Barth Relationship added related to 0019491
2012-06-01 14:15 Sven Barth Status new => acknowledged
2012-12-16 15:11 Sven Barth Fixed in Revision => 23158
2012-12-16 15:11 Sven Barth Status acknowledged => resolved
2012-12-16 15:11 Sven Barth Fixed in Version => 2.7.1
2012-12-16 15:11 Sven Barth Resolution open => fixed
2012-12-16 15:11 Sven Barth Assigned To => Sven Barth
2012-12-16 15:11 Sven Barth Note Added: 0064334
2018-02-08 18:17 Marco van de Voort Status resolved => closed