Funktionsparameter Klassentyp

[fliegermichl]

Wenn ich eine Klasse von einer anderen ableite, dann kann ich einer Variablen vom Typ der Basisklasse jede davon abgeleitete Klasse zuweisen.
Bei Funktionsparametern scheint das nicht zu gehen?

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

type

  TMyBase = class
    fId : integer;
  end;

  TMySecond = class ( TMyBase )
  private
   fid2 : integer;
  public
   property id2 : integer read fid2 write fid2;
  end;

  TMyfunc = function(a : TMyBase) : integer;

var
  func : TMyFunc;

implementation

function CallMe(a : TMySecond) : integer;
begin
  Result := a.Id2;
end;

initialization
  func := @CallMe;
end.

Bei der Zuweisung an func nach der Initialisierung meckert der Compiler:

Code: Alles auswählen

Error: Incompatible types: got "<address of function(TMySecond):LongInt;Register>" expected "<procedure variable type of function(TMyBase):LongInt;Register>"

Ich könnte natürlich der Function CallMe TMyBase als Parameter verpassen. Dann müsste ich aber jedesmal einen Typecast machen.
Gibt es da eine elegantere Lösung?

[m.fuchs]

Wenn ich eine Klasse von einer anderen ableite, dann kann ich einer Variablen vom Typ der Basisklasse jede davon abgeleitete Klasse zuweisen.
Bei Funktionsparametern scheint das nicht zu gehen?

Dein Beispiel kann und darf nicht gehen. TMyfunc muss alles verarbeiten können was TMyBase ist, wenn deine Funktion CallMe das nicht leistet, dann passt es nicht.

Ich könnte natürlich der Function CallMe TMyBase als Parameter verpassen. Dann müsste ich aber jedesmal einen Typecast machen.
Gibt es da eine elegantere Lösung?

Nicht nur einen Typecast, du müsstest vorher noch prüfen dass wirklich nur eine TMySecond übergeben wurde und andernfalls eine Exception werfen.
So richtig schön und sauber ist diese Architektur aber auch nicht.

[Sieben]

Wenn ich eine Klasse von einer anderen ableite, dann kann ich einer Variablen vom Typ der Basisklasse jede davon abgeleitete Klasse zuweisen.

Du versuchst in deinem Beispiel aber gerade umgekehrt, eine abgeleitete 'höhere' Klasse so zu verwenden als seien ihre Eigenschaften - hier fid2 - auch schon in der Basisklasse vorhanden. Das geht auch auf Klassenebene nicht - wenn du die abgeleitete Klasse als Variable vom Typ der Basisklasse vorliegen hast, kannst du zunächst auch nur die Eigenschaften und Methoden der Basisklasse verwenden, dh nur solche, die beide schon gemeinsam haben. Ansonsten wäre hier auch ein Typecast notwendig, um eben über die gemeinsame Basis hinauszugehen.

[PascalDragon]

Bei der Zuweisung an func nach der Initialisierung meckert der Compiler:

Code: Alles auswählen

Error: Incompatible types: got "<address of function(TMySecond):LongInt;Register>" expected "<procedure variable type of function(TMyBase):LongInt;Register>"

Natürlich meckert der Compiler. Die Signaturen der beiden Methoden sind schließlich unterschiedlich. Dabei spielt es keine Rolle, dass ein TMySecond einer TMyBase zugewiesen werden kann.

Die einzige Ausnahme hierzu ist, wenn du eine virtuelle Methode hast, welche ein Klasse zurückgibt und du eine abgeleitete Methode hast, welche eine Kindklasse zurückgibt (das nennt sich „type coercion”).

Code: Alles auswählen

program tcoercion;

{$mode objfpc}

type
  TBase = class

  end;

  TSub = class(TBase)

  end;

  TTest = class
    function Test: TBase; virtual;
  end;

  TTestSub = class(TTest)
    function Test: TSub; override;
  end;

function TTest.Test: TBase;
begin
  Result := TBase.Create;
end;

function TTestSub.Test: TSub;
begin
  Result := TSub.Create;
end;

var
  t: TTest;
  b: TBase;
begin
  t := TTest.Create;
  try
    b := t.Test;
    b.Free;
  finally
    t.Free;
  end;
end.

(Beim Zuweisen an Methodenzeiger müssen die Signaturen dennoch übereinstimmen)

[fliegermichl]

Danke für die Erklärung. Der Gedanke hinter dem ganzen ist, daß ich in meiner Basisklasse (abgeleitet von TList) einige Methoden implementiert habe, welche nach bestimmten Kriterien Unterobjekte liefern und das soll natürlich in abgeleiteten Klassen auch funktionieren.

Code: Alles auswählen

{$ModeSwitch nestedprocvars}
type
 TBase = class;
 TFirstThatFunction = function(Item : TBase) : boolean is Nested;
 TBase = class ( TList )
  function FirstThat(Test : TFirstThatFunction) : TBase;
 end;

implementation

function TBase.FirstThat(Test : TFirstThatFunction) : TBase;
var i : integer;
begin
 for i := 0 to Count - 1 do
 begin
  Result := TBase(Items[i]);
  if Test(Result) then exit;
 end;
 Result := nil;
end;

Was genau in der Testfunktion geprüft wird, steht hier noch nicht fest und ist vom Anwendungsfall abhängig.
Ich hab beispielsweise in einer abgeleiteten Klasse ein Flag modified. Wenn das abgefragt wird, dann gilt: Modified ist True wenn das Objekt oder eines seiner Unterobjekte Modified True gesetzt hat.

Code: Alles auswählen

// Getter for modified Flag
function TDerived.GetModified : boolean;
 function Test(Item : TBase) : boolean;
 begin
   Result := TDerived(Item).Modified;
  end;
begin
 Result := fModified;
 if not Result then Result := Assigned(FirstThat(@Test));
end;

Hier wird rekursiv durch alle Unterobjekte iteriert und geschaut, ob sich eines findet, welches modifiziert wurde.
Das ganze funktioniert einwandfrei, ich muss halt jedesmal einen TypeCast machen.

Ich kann natürlich FirstThat virtual machen und dann in jeder abgeleiteten Klasse neu definieren mit dem jeweiligen Klassentyp.
Das führt aber die Funktionalität der Vererbung ad absurdum.
Es bräuchte sowas wie ein Parameter vom Typ (TBase oder einer seiner Nachfahren).

[PascalDragon]

Du könntest mit generischen Funktionen arbeiten:

Die TBase-Klasse:

Code: Alles auswählen

unit ugenpara;

{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}

interface

uses
  Classes;

type
 TBase = class;
 generic TFirstThatFunction<T{: TBase}> = function(Item : T) : boolean is Nested;
 TBase = class ( TList )
  generic function FirstThat<T: TBase>(Test : specialize TFirstThatFunction<T>) : T;
 end;

implementation

generic function TBase.FirstThat<T>(Test : specialize TFirstThatFunction<T>) : T;
var i : integer;
begin
 for i := 0 to Count - 1 do
 begin
  Result := T(Items[i]);
  if Test(Result) then exit;
 end;
 Result := nil;
end;

end.

Die TDerived-Klasse:

Code: Alles auswählen

program tgenpara;

{$mode objfpc}
{$modeswitch nestedprocvars}

uses
  ugenpara;

type
  TDerived = class(TBase)
  private
    fModified: Boolean;
    function GetModified: Boolean;
  public
    property Modified: Boolean read GetModified;
  end;

function TDerived.GetModified : boolean;

  function Test(Item : TDerived) : boolean;
  begin
    Result := Item.Modified;
  end;

begin
  Result := fModified;
  if not Result then Result := Assigned(specialize FirstThat<TDerived>(@Test));
end;

begin

end.

Auf Grund einer Schwäche im Compiler kann man leider den Constraint in TFirstThatFunction<> nicht nutzen, aber durch den Constraint in FirstThat<> passt das dennoch.

[Niesi]

Was ist eigentlich aus der Aufforderung geworden, dass das Programmieren EINFACH zu sein hat?

Das hat der Niklaus Wirth doch uns allen mit auf den Weg gegeben.

Wenn ich solche Konstrukte sehe, denke ich immer: Wer wollte sich denn da wieder verwirklichen?

[fliegermichl]

Du könntest mit generischen Funktionen arbeiten:
...

Diese Möglichkeit ist interessant. Weniger Schreibarbeit ist dann aber doch der TypeCast.

[PascalDragon]

Was ist eigentlich aus der Aufforderung geworden, dass das Programmieren EINFACH zu sein hat?

Das hat der Niklaus Wirth doch uns allen mit auf den Weg gegeben.

Wenn ich solche Konstrukte sehe, denke ich immer: Wer wollte sich denn da wieder verwirklichen?

Was ist hieran bitte nicht „einfach”? Ich mache hier nichtmal Feature Abuse, sondern nutze Generics für genau das wofür sie vorgesehen sind: typsicheren Code unter Vermeidung von Code Duplikation.

Du könntest mit generischen Funktionen arbeiten:
...

Diese Möglichkeit ist interessant. Weniger Schreibarbeit ist dann aber doch der TypeCast.

In FPC main kannst du theoretisch mit Hilfe von {$modeswitch implicitfunctionspecialization} den Aufruf noch etwas vereinfachen:

Code: Alles auswählen

if not Result then Result := Assigned(FirstThat(@Test));

Ich sage theoretisch, weil in diesem Fall noch ein Bug vorhanden zu sein scheint, der zu nem Compilerfehler führt...