CODEWITHSUNDEEP
oopada
Albatros23
Albatros23

Reputation: 331

private type extension and dispatching on private primitives in Ada

I'm trying to hide some aspects of a library to the users and reading the RM for type conversions, I can't understand why the following code fails.

A user will instantiate root.child.concrete.concrete_t and then will call to root.p_userInterface passing that instance, but a compilation error is being thrown on root.adb: invalid tagged conversion, not compatible with type "child_t'class" defined at root-child.ads:4

root.ads:

limited with root.child;

package root is

  procedure p_userInterface (obj : in out root.child.child_t'Class);

private

  type root_t is abstract tagged null record;

  procedure p_primitive (this : in out root_t) is abstract;

end root;

root.adb:

with root.child;

package body root is

  procedure p_userInterface (obj : in out root.child.child_t'Class) is
  begin
    -- error: invalid tagged conversion, not compatible with type "child_t'class" defined at root-child.ads:4
    root_t'Class(obj).p_primitive; 
  end p_userInterface;

end root;

root-child.ads:

package root.child is

  type child_t is abstract tagged private;

  function f_getComponent(this : in child_t) return Integer;

private

  type child_t is abstract new root_t with
    record
      component : Integer;
    end record;
  
  overriding
  procedure p_primitive (this : in out child_t) is abstract;

end root.child;

root-child.adb:

package body root.child is
  
  function f_getComponent(this : in child_t) return Integer is
  begin
    return this.component;
  end f_getComponent;

end root.child;

root-child-concrete.ads:

package root.child.concrete is

  type concrete_t is new child_t with private;

  procedure p_setAnotherComponent (this : in out concrete_t;
                                  c    : Boolean);

  function f_getAnotherComponent (this : concrete_t) return Boolean;

private

  type concrete_t is new child_t with
    record
      anotherComponent : Boolean;
    end record;
  
  overriding
  procedure p_primitive (this : in out concrete_t);

end root.child.concrete;

root-child-concrete.adb:

package body root.child.concrete is

  procedure p_primitive (this : in out concrete_t) is
  begin
    -- for example
    this.anotherComponent := True;
  end p_primitive;

  procedure p_setAnotherComponent (this : in out concrete_t;
                                   c    : Boolean) is
  begin
    this.anotherComponent := c;
  end p_setAnotherComponent;

  function f_getAnotherComponent (this : concrete_t) return Boolean is
  begin
    return this.anotherComponent;
  end f_getAnotherComponent;


end root.child.concrete;

Why? I understand that the implementation of root is not able to see the private part of its root.child child package, thus is not able to see that type child_t is extending root_t privately. Am I right?
Can I achieve something like this differently? I would like to hide p_primitive to the users because is to perform internal things, but I would like to dispatch it internally if it's possible.

Upvotes: 1

Views: 120

Answers (1)

Albatros23
Albatros23

Reputation: 331

I think I have finally achieved it. Here is the solution that works for me, only on changed units, commenting out the old parts, as I can't use html strike tag to cross out code:

root.ads:

--limited with root.child;

package root is

  type root_t is abstract tagged null record;

  procedure p_userInterface (obj : in out root_t'Class); --root.child.child_t'Class);

private

  --type root_t is abstract tagged null record;

  --procedure p_primitive (this : in out root_t) is abstract;

  type hiddenRoot_t is abstract new root_t with null record;

  procedure p_primitive (this : in out hiddenRoot_t) is abstract;

end root;

root.adb:

--with root.child; It was not needed before neither

package body root is

  procedure p_userInterface (obj : in out root_t'Class) is --root.child.child_t'Class) is
  begin
    --root_t'Class(obj).p_primitive; -- invalid tagged conversion, not compatible with type "child_t'class"

    hiddenRoot_t'Class(obj).p_primitive;

  end p_userInterface;

end root;

root-child.ads:

package root.child is

  --type child_t is abstract tagged private;
  type child_t is abstract new root_t with private;

  function f_getComponent(this : in child_t) return Integer;

private

  --type child_t is abstract new root_t with
  type child_t is abstract new hiddenRoot_t with
    record
      component : Integer;
    end record;
  
  overriding
  procedure p_primitive (this : in out child_t) is abstract;

end root.child;

This way I'm able to dispatch privately to the implementation of p_primitive of a concrete_t type, and on a main I can ensure that an instance of concrete_t has no visibility of p_primitive. Any further comment to this solution will be appreciated, I do not know if I'm missing something important, but seems to work. I have no idea if it is the correct solution.

Upvotes: 1

Related Questions