Prüfen, ob eine Method überschriben wurde

[Martin W]

Hi,

folgendes Problem:

Delphi-Quellcode:

interface 

type
  TBaseClass = class
  public
    procedure DoSomething; virtual; abstract;
    constructor Create;
  end;

type
  TWorkClass = class(TBaseClass)
  public
    procedure DoSomething; override;
  end;

implementation

constructor TBaseClass.Create;
begin

  if (DoSomething wurde überschrieben) then
    begin
      DoSomething;
    end;

end;

Wie kann ich das Problem lösen? Idee von C#, siehe https://stackoverflow.com/questions/...g-reflection-c.

Viele Grüße,
Martin

[himitsu]

Sieh dir mal das/die Seek vom TStream an.

Im Prinzip: Die Adresse aus der VMT auslesen und mit dem Pointern der Methode vergleichen. Oder uber die RTTI die Adresse ermitteln.

[Martin W]

Idee:

Delphi-Quellcode:

interface

type
  TBaseClass = class
  public
    procedure DoSomething; virtual; abstract;
    constructor Create;
  end;

type
  TWorkClass = class(TBaseClass)
  public
    procedure DoSomething; override;
  end;

implementation

constructor TBaseClass.Create;
var
  Impl: procedure of object;
  Base: procedure of object;
  varClass: TClass;
begin

  Impl := DoSomething;

  varClass := self.ClassType;

  while (varClass <> nil) AND (varClass <> TBaseClass) do
    varClass := varClass.ClassParent;

  if (varClass <> nil) then
    begin
     
      Base := TBaseClass(@varClass).DoSomething;

      if TMethod(Impl).Code <> TMethod(Base).Code then
        begin
          DoSomething;
        end;

    end;

end;

[Martin W]

Der obere Code funktioniert leider nur dann einwandfrei, wenn die Klasse tatsächlich überschrieben wurde, sonst gibt es einen abstrakten Fehler. Hab ich etwas übersehen?

[Sir Rufo]

Schau dir mal die Implementierung von

Delphi-Quellcode:

TStream.Seek

an, da wird genau das gemacht ;)

[Martin W]

Hi,

Ja, genau aus dieser Funktion habe ich meinen oberen Code extrahiert. Habe ich etwas falsch übernommen?

Habe das Gefühl, dass die Lösung wieder mal so einfach ist, dass ich den Fehler ständig übersehe... :oops:

Viele Grüße,
Martin

[Sir Rufo]

Jupp, im Original (

Delphi-Quellcode:

TStream.Seek

) ist die Methode als

Delphi-Quellcode:

virtual;

und nicht als

Delphi-Quellcode:

virtual; abstract;

deklariert.

Daher bekommst du auch den abstrakten Fehler ;)

[himitsu]

Daher auch der zweite Absatz in #2.

[Sir Rufo]

Zitat:

Zitat von himitsu (Beitrag 1272451)

Daher auch der zweite Absatz in #2.

Huch, war das eben auch schon da? :stupid:

[mse1]

Für nicht abstrakte Methoden geht in FPC mit {$mode objfpc} auch

Delphi-Quellcode:

type
 TBaseClass = class
  public
   procedure DoSomething; virtual; //abstract;
            //darf nicht abstract sein sonst fehlt symbol fuer linker
   constructor Create;
 end;

type
 TWorkClass = class(TBaseClass)
  public
   procedure DoSomething; override;
 end;
 
constructor TBaseClass.Create;
begin
 if TMethod(@DoSomething).Code <> Pointer(@TBaseClass.DoSomething) then begin
  DoSomething();
 end;
end;

Mit {$mode delphi} wird es zu

Delphi-Quellcode:

type
 TBaseClass = class
  public
   procedure DoSomething; virtual; //abstract;
            //darf nicht abstract sein sonst fehlt symbol fuer linker
   constructor Create;
 end;

type
 TWorkClass = class(TBaseClass)
  public
   procedure DoSomething; override;
 end;
 procty = procedure() of object;
  
constructor TBaseClass.Create;
begin
 if TMethod(procty(DoSomething)).Code <> Pointer(@TBaseClass.DoSomething) then begin
  DoSomething();
 end;
end;

welches vielleicht auch in Delphi funktioniert.

[Martin W]

Ja, gesehen! Danke! :wink: