procedure of class

[JackT 0]

I am trying to cast a class function to a pointer as opposed to a procedure of object.

 

For example 

 

TProcReportError = function(Sender:Tobject;const CrashMsg:String) of object; 

 

creates a pointer to a function of an object.

 

I want do the same thing with a class function - for example

 

TProcReportError = procedure(Sender:TObject;const CrashMsg:String) of class; 

 

I tried this and then used 

 

TProcReportError = procedure(Sender:TObject;const CrashMsg:String);

 

In this real example

 

type TPrepareNewState = function(Sender, Commander: TObject): String;

 

function TN1.ControllerCommand: AnsiString;
var
CRef:TClass;
NS:String;
P:Pointer;
PNS:TPrepareNewState;
Z:TN1;
begin
if Assigned(Commander) then
begin
//   Commander.PrepareNewState(Self,Commander);
NS:='';
CRef := Commander.ControllerClass;
if CRef <> nil then
begin
  if CRef.InheritsFrom(TN1BaseAutoCommander) then
  begin
      P:= Cref.MethodAddress('PrepareNewState');
      if P = nil then
      begin
        //raise Exception.Create(CRef.ClassName + ' does not implement PrepareNewState');
        RESULT := 'ERROR '+CRef.ClassName + ' does not implement PrepareNewState';
        exit;
      end;
      ODS('Attempting call on ' + CRef.ClassName);
      PNS:=P;
      Z:=Self as TN1;
      NS:=PNS(Z,Commander);
      ODS(NS);
      Commander.TrySwitchState(NS);
      RESULT := 'OK';
  end;
end
else
begin
  RESULT :='ERROR COMMANDER DOES NOT HAVE A CONTROLLER CLASS';
end;
end
else
begin
  RESULT := 'ERROR UNASSIGNED COMMANDER';
end;
end;

It calls this command. The line N1:=Sender As TN1 throws an exception as it doesn't think Sender is a class of TN1, but in the previous procedure we tested this assertion by setting Z := Self As TN1;

 

The only thing I can think is happening is that parameters are being passed incorrectly ?

 

I assumed a class function would behave like a module level function for casting purposes ?

 

Quote

class function TN1PassiveController.PrepareNewState(Sender,
  Commander: TObject): String;
  var
  N1:TN1;
  CS:String;
  Sarge:TN1Commander;
  CParams:TArray<String>;
begin
  N1 := Sender As TN1;
  CParams := N1.GetCommandParameters;

  N1.DumpCSL;
  Sarge := Commander As TN1Commander;

    if Length(CParams) >1 then
    begin
      CS := CParams[1];
      if CS ='ACTIFY' then
      begin
        Sarge.ActiveChannels
      end;
      Sarge.TrySwitchState(CParams[1]);
      Result :='OK';
    end
    else
    begin
       Result := 'ERROR NOT ENOUGH PARAMETERS PASSED TO TN1PassiveController';
    end;

end;

 

 

 

 

 

[Remy Lebeau 1642]

Obviously, I'm aware of the existence of class procedures/functions, but I've never seen a "procedure of class" declaration before. I didn't know that was a possibility.

 

In any case, a "class" procedure/function still has a hidden Self parameter, it simply points at the class type instead of an object instance.  Your code is not taking that parameter into account.  You have to declare a "class" procedure/function as "static" in order to remove its Self parameter.

Edited Monday at 08:29 PM by Remy Lebeau

[JackT 0]

Thanks for the reply there isn't a procedure of class function but that is what I am trying to do.

It's a bit crazy complicated - I have a class reference to an interfaced object which I pass into a threaded object that creates that class.

Somewhere down the line I read a string from a piece of hardware and then load up a new class interface to replace the original one depending on the hardware system. This is because there might be multiple versions of the hardware firmware out in the wild. 

I then want to issue commands to the discovered piece of hardware, but I need to get back the new class reference, so I can call class functions to prepare data for other calls without knowing the specifics of the class I am dealing with. I was using virtual methods, but this doesn't look like it is possible so I will try with static methods and remove the function from the base class.

 

 

 

[JackT 0]

Cheers! That worked, so getting the address of a class function that has been declared as a virtual function causes the parameters to that function to be passed incorrectly.

This is ok for me but it means you can't use inherit code from ancestor classes I guess.

 

 

[Remy Lebeau 1642]

Your descriptions are a bit confusing. Can you show the updated code that is not working the way you want?

Edited Monday at 08:31 PM by Remy Lebeau

[Lars Fosdal 1877]

@JackT So you retrieve a signature from the hardware, and want to have custom classes, either descending from a single parent (with children overriding virtual methods) - or - implementing a common interface (if the classes need to have different parents) - and create device specific class instances that do the appropriate software operations on specific hardware?

 

Sounds to me that you need a Factory that produces your class depending on the signature - where each class register itself with the corresponding signature(s).

It would be safer to pass an instance of the class, than a reference to a function of the class.

 

[JackT 0]

This is is what I am attempting to do.

I have a hardware controller  that is running two threads

The outer threads accepts commands through a pipe from a controlling program UI.

When commanded to do the outer thread spawns a generic controller program on the inner thread, so as not to block the control pipe.

From the outer thread I specify a control module, that the inner thread is going to use to do the actual controlling.

I don't want to pass an actual object across threads because this is bad thing to do as it can lead to objects getting destroyed at the wrong time 
therefore I pass a class reference and create that object in the controlling thread.

 The referenced class is an interfaced object that may or not support specific interfaces, but generally the first object creates a very basic
 hardware interface that just queries the hardware firmware details.
 
 When the initial interfaced object gets the results of the hardware query interface it looks up a specific controller from an internal list and if it is
 present it creates another controller in the internal thread and sets this to the current controller interface. This destroys the original controller interface and the new controller carries on. If a specific controller isn't found the inner thread throws an exception, stores the error result and terminates.
 
That aside there are circumstances where it is handy to know in the outer thread the current class reference of the controller. 
So I want to be able to pass back the class reference of the current loaded controller and then use class functions in that class reference to retrieve meta data and helper routines from the class reference 
that can be used to prepare data before pushing information to the inner thread.

There is no language mechanism to declare a procedure of a class, or a function of a class.

Even though you can declare class procedures as virtual.

 

I can however get the method address of a virtual class function but I can not cast it to a suitable function Type.

I thought class function would all be static in nature so I just tried casting it to a standard module procedure 

some thing like this.

  type TMyproc = function(P1,P2:Variant):Variant;
  
  
 class function (P1,P2:Variant):Variant;virtual; can not be cast to a suitable method pointer because there is no language mechanism to do this
 
 class function DoSomething():Integer;static; can be cast to TMyProc pointer type because the static key word removes the self reference
 
 This means that it is not possible to get a function pointer in a class function or procedure that has been declared virtual and then call it
 because the function call isn't being fixed up correctly.
 
 
 If the novel language mechanism "procedure / function of class" were implemented then this might be possible.
 
 This would then be a handy way of passing metadata between threads, for example it could pass a list of supported commands or a data decompression routine without having to instantiate an object  an actual object, which could be overridden with updated versions in descendant classes.
  

------>OUTER THREAD-------->  START INNER THREAD(INIITAL CLASSREF)

                                                   CREATE BASIC CONTROLLER HERE USING CLASSREF
                            
                                                    QUERY HARDWARE
                            
                                                   REPLACE CONTROLLER WITH DESENDANT CONTROLLER THAT INHERITS FROM BASIC CONTROLLER
ASK FOR INNER CLASS REF -->
                            
                                                    LOOP
                            
                                                    DO CONTROLLER ACTIONS
                            
                            
                                                    UNTIL TERMINATED

------>OUTER THREAD-------->INNER THREAD

[Lars Fosdal 1877]

@JackT - I've attempted an over-simplified draft of how I would envision doing this.

It allows multiple communication methods, and multiple controllers, but I've left out the configuration loading and command/result passing.
I'd use input/output "mailbox queues" as those are the simplest to make thread safe.

 

program DynamicCommsClass;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Generics.Defaults, Generics.Collections;

type
  TSignature = string;

  IDeviceInterface = interface(IInterface)  ['{C8D5A4A7-A153-4962-8F89-980825B0E503}']
    function FetchSignature: TSignature;
    function Verb1: integer;
    function Verb2: integer;
  end;

  TDeviceObject = class(TInterfacedObject, IDeviceInterface) // contains relevant comms class (serial, tcp, REST, etc)
    function FetchSignature: TSignature; virtual;
    function Verb1: Integer; virtual;
    function Verb2: Integer; virtual;
  end;

  TBaseController = class(TObject)
  type
    TBaseControllerType = class of TBaseController;
    TControllerDictionary = class(TDictionary<TSignature, TBaseControllerType>);
  class var
    Master: TControllerDictionary; // a complete master list of known controllers
  protected
     Device: IDeviceInterface;
  public
    class constructor InitClass;
    class destructor UnInitClass;
    class function Signature: TSignature; virtual;
    class procedure RegisterControllers(const aControllerList: Array of TBaseControllerType);
    class function FindController(const aSignature: TSignature): TBaseControllerType;

    function Connect: TBaseController; virtual;
    constructor Create; virtual;
    procedure CreateDeviceObject; virtual;
    procedure LoadConfiguration; virtual;

    function Verb1: Integer; virtual;
    function Verb2: Integer; virtual;
  end;

  TThisController = class(TBaseController)
  public
    constructor Create; override;
    class function Signature: TSignature; override;
  end;

  TThatController = class(TBaseController)
    constructor Create; override;
    class function Signature: TSignature; override;
  end;

{ TDeviceObject }

function TDeviceObject.FetchSignature: TSignature;
begin
  // Get the signature from the device
end;

function TDeviceObject.Verb1: Integer;
begin
  // exect command 1 on the device
end;

function TDeviceObject.Verb2: Integer;
begin
  // exect command 2 on the device
end;

{ TBaseController }

constructor TBaseController.Create;
begin
  Inherited;
  CreateDeviceObject;
  LoadConfiguration;
end;

procedure TBaseController.CreateDeviceObject;
begin
  Device := TDeviceObject.Create;
end;

class destructor TBaseController.UnInitClass;
begin
  Master.Free;
end;

class constructor TBaseController.InitClass;
begin
  Master := TControllerDictionary.Create(11); // or whatever prime size needed
end;

class procedure TBaseController.RegisterControllers(
  const aControllerList: Array of TBaseControllerType);
begin
  for var Controller in aControllerList
  do Master.TryAdd(Controller.Signature, Controller);
end;

class function TBaseController.FindController(
  const aSignature: TSignature): TBaseControllerType;
begin
  if not Master.TryGetValue(aSignature, Result)
   then raise Exception.Create(Format('Signature %s not recognized.', [aSignature]));
end;

class function TBaseController.Signature: string;
begin
  Result := 'Default';
end;

function TBaseController.Connect: TBaseController;
var
  Sig: TSignature;
begin
  Sig := Device.FetchSignature;
  if Sig = Self.Signature
   then Result := Self
  else begin
    var ControllerType := FindController(Sig);
    Result := ControllerType.Create;
  end;
end;

procedure TBaseController.LoadConfiguration;
begin
  // from somewhere
end;

function TBaseController.Verb1: Integer;
begin
  Result := Device.Verb1;
end;

function TBaseController.Verb2: Integer;
begin
  Result := Device.Verb2;
end;


{ TThisController }

constructor TThisController.Create;
begin
  inherited;

end;

class function TThisController.Signature: TSignature;
begin
  Result := 'ThisControllerSign';
end;

{ TThatController }

constructor TThatController.Create;
begin
  inherited;

end;

class function TThatController.Signature: TSignature;
begin
  Result := 'ThatControllerSign';
end;

// -------

procedure ThreadExecute;
var
  InitialController, Controller: TBaseController;
begin
  InitialController := TBaseController.Create;
  Controller := Controller.Connect;
  if InitialController <> Controller
   then InitialController.Free;

//  while not Terminated
//  do begin
       // Overly simplified - but basically fetch from input queue to decide what to process
//     Controller.Verb1;
//     Controller.Verb2;
//     Sleep(1000);
//  end;
end;

begin
  TBaseController.RegisterControllers([TThisController, TThatController]);
  try
    ThreadExecute;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

 

Edited 15 hours ago by Lars Fosdal
Fixed a flaw in ThreadExecute

[Kas Ob. 152]

23 hours ago, JackT said:

------>OUTER THREAD-------->  START INNER THREAD(INIITAL CLASSREF)

                                                   CREATE BASIC CONTROLLER HERE USING CLASSREF
                            
                                                    QUERY HARDWARE
                            
                                                   REPLACE CONTROLLER WITH DESENDANT CONTROLLER THAT INHERITS FROM BASIC CONTROLLER
ASK FOR INNER CLASS REF -->
                            
                                                    LOOP
                            
                                                    DO CONTROLLER ACTIONS
                            
                            
                                                    UNTIL TERMINATED

------>OUTER THREAD-------->INNER THREAD

For me that looks tightly coupled and hard to maintain in the long run, and i am always against such approach "REPLACE CONTROLLER...", if you need to replace then it is too late either get the correct one form the beginning or create new one and dispose them both later, swapping/replacing only will lead to complex design with high error/malfunctioning probability (if not now then modifying the code later).

 

Lars gave a great example, but i would do it a little different, by slicing things into pieces.

 

Look at Lars example,

1) a Factory will be perfect to return an IDeviceController from TSignature (the HardwareID) 

2) Devices could have their own units and will register them self if the Unit is included in the project, (Initialization clause)

3) Factory will parse and return from what available (runtime registered) IDevices/IDeviceController ...

4) the Verbs (command/capabilities) could be an interface, each one is an interface, so a device could have 10 interfaces (more or less), each represent small functionality, like IDeviceCapName which will handle the device.. well ..name, IDeviceCapWrite, IDeviceCapRead.... so the the returned Interface cab tested/checked against a specific command/verb by simply call Supports() or with "is" or "as" ...  , so when it comes to execute command a simple call like Supports to check if the device can return IDeviceCapOnlineTime then perform the required call on that ..

5) With separated and isolated commands/verbs like that, it is easier to accompany them with extra attached interface that will bring what type of hardware steps or code should be performed, in other words you can have script like (even it is code) in default interfaces specific for each device, so i device like IDeviceDoorController can have IDeviceDoorControllerCloseAndLock and IDeviceDoorControllerUnLock ...IDeviceDoorControllerOpenFroAll.. which are returned by it own smaller factory from the DoorController unit which is also registered and returned by IDeviceDoorController.

 

I am sure i missed many steps here, but i hope the idea is clear to at least entertain, this will be expandable easy to read and maintain, and most importantly (importanter) it is testable, in fact it is the easiest way to develop for such hardware design, were each can have their own commands.

[Lars Fosdal 1877]

@Kas Ob. I agree on splitting the devices into separate units, but for sake of the example to a minimum, I didn't show that.

Ref 1) - Master in TBaseController is in principle the core factory, but could be separate.

Ref 4) - Multiple interfaces is defintively an option. A capability discovery mechanism is a good idea.

 

The main point of my example was to show a method for avoiding passing unsafe pointers to methods.
That said, passing objects is only safe as long as you are in full control of the lifespan of, and access to, said objects.

 

Using class types (TMyClassType = class of TMyType) and encapsulation is a good way of handling polymorphic instantiation in a reasonably tidy way.

Using libs like f.x. Primož Gabrijelčič's OmniThreadLibrary really helps solving common threading challenges. Gotta love thread safe queues.

[JackT 0]

Thanks for the replies. I appreciate the effort you have all put into answering my question.