This was prompted by Deltic's answer, I wanted to provide an counter-example proving you can use generics for the animal feeding routine. (ie: Polymorphic Generic List)
First some background: The reason you can feed generic animals using a generic base list class is because you'll usually have this kind of inheritance:
TBaseList = class
// Some code to actually make this a list
end
TSpecificList = class(TBaseList)
// Code that reintroduces the Add and GetItem routines to turn TSpecificList
// into a type-safe list of a different type, compatible with the TBaseList
end
This doesn't work with generics because you'll normally have this:
TDogList = TList<TDog>
end
TCatList = TList<TCat>
end
... and the only "common ancestor" for both lists is TObject
- not at all helpful. But we can define a new generic list type that takes two class arguments: a TAnimal
and a TSpecificAnimal
, generating a type-safe list of TSpecificAnimal
compatible with a generic list of TAnimal
. Here's the basic type definition:
TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
private
function GetItem(i: Integer): T2;
public
procedure Add(A:T2);
property Item[i:Integer]:T2 read GetItem;default;
end;
Using this we can do:
TAnimal = class;
TDog = class(TAnimal);
TCat = class(TAnimal);
TDogList = TCompatibleList<TAnimal, TDog>;
TCatList = TCompatibleList<TAnimal, TCat>;
This way both TDogList and TCatList actually inherit from TObjectList<TAnimal>
, so we now have a polymorphic generic list!
Here's a complete Console application that shows this concept in action. And that class is now going into my ClassLibrary for future reuse!
program Project23;
{$APPTYPE CONSOLE}
uses
SysUtils, Generics.Collections;
type
TAnimal = class
end;
TDog = class(TAnimal)
end;
TCat = class(TAnimal)
end;
TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
private
function GetItem(i: Integer): T2;
public
procedure Add(A:T2);
property Item[i:Integer]:T2 read GetItem;default;
end;
{ TX<T1, T2> }
procedure TCompatibleList<T1, T2>.Add(A: T2);
begin
inherited Add(T1(TObject(A)));
end;
function TCompatibleList<T1, T2>.GetItem(i: Integer): T2;
begin
Result := T2(TObject(inherited Items[i]));
end;
procedure FeedTheAnimals(L: TObjectList<TAnimal>);
var A: TAnimal;
begin
for A in L do
Writeln('Feeding a ' + A.ClassName);
end;
var Dogs: TCompatibleList<TAnimal, TDog>;
Cats: TCompatibleList<TAnimal, TCat>;
Mixed: TObjectList<TAnimal>;
begin
try
// Feed some dogs
Dogs := TCompatibleList<TAnimal, TDog>.Create;
try
Dogs.Add(TDog.Create);
FeedTheAnimals(Dogs);
finally Dogs.Free;
end;
// Feed some cats
Cats := TCompatibleList<TAnimal, TCat>.Create;
try
Cats.Add(TCat.Create);
FeedTheAnimals(Cats);
finally Cats.Free;
end;
// Feed a mixed lot
Mixed := TObjectList<TAnimal>.Create;
try
Mixed.Add(TDog.Create);
Mixed.Add(TCat.Create);
FeedTheAnimals(Mixed);
finally Mixed.Free;
end;
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.