[fpc-devel] Class property and virtual getter

[Sven Barth]

On 26.05.2014 14:45, Michael Schnell wrote:
> I suppose this would work independently of virtual, as no "Self" is
> involved at all.
>
> It might be some work to do a test. It could e.g. use two siblings and
> detect if different classtype values are found in the two siblings.

Here... happy now? ;)

=== code begin ===

program tclassvirtual;

{$mode objfpc}

type
   TBase = class
     class procedure Test; virtual;
   end;

   TSub1 = class(TBase)
     class procedure Test; override;
   end;

   TSub2 = class(TBase)
     class procedure Test; override;
   end;

   TBaseClass = class of TBase;

class procedure TBase.Test;
begin
   Writeln(Self.ClassName);
end;

class procedure TSub1.Test;
begin
   Writeln('TSub1');
   inherited;
end;

class procedure TSub2.Test;
begin
   Writeln('TSub2');
   inherited;
end;

var
   b: TBaseClass;
begin
   TBase.Test;
   TSub1.Test;
   TSub2.Test;

   b := TBase;
   b.Test;
   b := TSub1;
   b.Test;
   b := TSub2;
   b.Test;
end.

=== code end ===

=== output begin ===

TBase
TSub1
TSub1
TSub2
TSub2
TBase
TSub1
TSub1
TSub2
TSub2

=== output end ===

Regards,
Sven