Коллекция классов - подскажите плз, что не так

[tria]

Есть следующий код (упрощенно):

Код: Выделить всё

TBaseClass=Class
Constructor Create(); virtual;
...
TBaseClass1=Class(TBaseClass)
Constructor Create(); override;
....
TBaseClasses = class of TBaseClass;

Procedure Do(cl:TBaseClasses);
var b:TBaseClass;
begin
  b:=Pointer(cl.Create());
end;


При вызове процедуры:
Do(TBaseClasses1);
вызывается конструктор TBaseClasses а не TBaseClasses1.
Что я делаю не так? Или как надо сделать, чтобы в процедуре Do() вызывался Constructor переданного класса?

[shade]

Конструктор нужно сделать вируальным

Код: Выделить всё

constructor TBaseClass.Create; virtual;
...
constructor TChildClass.Create; override;
...


[tria]

так он и есть виртуальный

[tria]

Нашел разницу между случаем, когда работает. Перепишу:

Код: Выделить всё

TBaseClass=Class
Constructor Create(); virtual;
...

TBaseClass1=Class(TBaseClass)
Constructor Create(); override;
....

TBaseClass2=Class(TBaseClass)
Constructor Create(); overload; override;
Constructor Create(p:TAnyClass); overload;
....

TBaseClasses = class of TBaseClass;

Procedure Do(cl:TBaseClasses);
var b:TBaseClass;
begin
  b:=Pointer(cl.Create());
end;


Так вот:
Do(TBaseClasses1); - вызывается конструктор TBaseClasses1
Do(TBaseClasses2); - вызывается конструктор TBaseClasses
Выходит, проблема в overload. Как ее обойти?

[shade]

Код: Выделить всё

program test_virt_constr;

{$mode objfpc}

uses Classes;

type
  TBaseClass = class
    constructor Create; virtual;
    destructor Destroy; override;
  end;
 
  TBaseClassItem = class of TBaseClass;
 
  TChildClass = class (TBaseClass)
    constructor Create; override;
    destructor Destroy; override;
  end;

constructor TBaseClass.Create;
begin
  inherited Create;
  writeln('TBaseClass.Create');
end;

destructor TBaseClass.Destroy;
begin
  writeln('TBaseClass.Destroy');
  inherited Destroy;
end;

constructor TChildClass.Create;
begin
  inherited Create;
  writeln('TChildClass.Create');
end;

destructor TChildClass.Destroy;
begin
  writeln('TChildClass.Destroy');
  inherited Destroy;
end;

var
  List: TList;
  ClassItem: TBaseClassItem;
  obj: TBaseClass;
begin
  List := TList.Create;
  ClassItem := TChildClass;
  List.Add(ClassItem);
  obj := TBaseClassItem(List[0]).Create;
  obj.Free;
end.


Ожидаемый вывод:

Код: Выделить всё

TBaseClass.Create
TChildClass.Create
TChildClass.Destroy
TBaseClass.Destroy

TBaseClass.Create и TBaseClass.Destroy вызваются, т.к. в моем примере вызыватся метод предка через inherited Create / inherited Destroy, если их убрать то будет просто

Код: Выделить всё

TChildClass.Create
TChildClass.Destroy


[tria]

> shade
Извини, что заставил сделать лишнюю работу. Идея о overload мне пришла в голову позже

[shade]

С overload тоже работает:

Код: Выделить всё

program test_virt_constr;

{$mode objfpc}

uses Classes;

type
  TBaseClass = class
    constructor Create; virtual; overload;
    destructor Destroy; override;
  end;
 
  TBaseClassItem = class of TBaseClass;
 
  TChildClass = class (TBaseClass)
    constructor Create; override;
    constructor Create(const msg: string);
    destructor Destroy; override;
  end;

constructor TBaseClass.Create;
begin
  inherited Create;
  writeln('TBaseClass.Create');
end;

destructor TBaseClass.Destroy;
begin
  writeln('TBaseClass.Destroy');
  inherited Destroy;
end;

constructor TChildClass.Create;
begin
  inherited Create;
  writeln('TChildClass.Create');
end;

constructor TChildClass.Create(const msg: string);
begin
  inherited Create;
  writeln('TChildClass.Create(''', msg, ''')');
end;

destructor TChildClass.Destroy;
begin
  writeln('TChildClass.Destroy');
  inherited Destroy;
end;

function create_base_class(cl: TBaseClassItem): TBaseClass;
begin
  Result := cl.Create;
end;

var
  obj: TBaseClass;
begin
  obj := create_base_class(TChildClass);
  obj.Free;
end.

[shade]

Чтобы не искать трудно обнаружимые ошибки, просто не давай им шанса появиться, а поэтому не используй похожие имена типа TBase1, TBase2, TBases,
используй более различные, например:
TFoo = class;
TBar = class (TFoo);
TBanana = class (TBar);
TFooClass = class of TFoo;

[tria]

На самом деле у меня все гороаздо сложнее и реальные имена классов другие, пример я привел упрощенный, дабы показать смысл проблемы.
Ваш код у меня дал тот же результат.
Единственно, у меня в программе используется {$MODE Delphi}
для этого случая пришлось добавить overload:

Код: Выделить всё

  TChildClass = class (TBaseClass)
    constructor Create; override; overload;
    constructor Create(const msg: string); overload;
    destructor Destroy; override;
  end;

В общем, "будем искать"