Re: Instantiating private types with discriminants?

["Ludovic Brenta" <ludovic@ludovic-brenta.org>]

rick H a écrit :
> with Ada.Integer_Text_IO;
> with Ada.Float_Text_IO;
>
> procedure Simple_Case is
>
>    type General_T is tagged null record;
>    type Access_T is access General_T'Class;
>
>    type Type_A is new General_T with
>    record
>       Data : Integer;
>    end record;
>
>    type Type_B is new General_T with
>    record
>       Data : Float;
>    end record;
>
>    procedure Put (Item: in General_T) is
>    begin
>       null;
>    end Put;
>
>    procedure Put (Item: in Type_A) is
>    begin
>       Ada.Integer_Text_IO.Put (Item.Data);
>    end Put;
>
>    procedure Put (Item: in Type_B) is
>    begin
>       Ada.Float_Text_IO.Put (Item.Data);
>    end Put;
>
>    Var_A : Access_T; --  could be "new Type_A" or a "new Type_B"
> begin
>
>    --  Var_A := new Type_A' (Data => 100);
>    Var_A := new Type_B' (Data => 100.0);
>
>    Put (Var_A.all);
> end Simple_Case;

First , per ARM 3.2.3, you should declare the three types and the Put
procedures inside a package (possibly nested in the Simple_Case
procedure), so that they fall under ARM 3.2.3(6). Otherwise, the Put
procedures are not primitive, and therefore not dispatching.

Secondly, you are being hit by what may be Ada's most subtle rules:
freezing rules (ARM 13.14).

The declaration of type Type_A freezes General_T, per ARM 13.14(7).
This means that after the declaration of Type_A, you can no longer
declare primitive subprograms of General_T; any subprograms you declare
thereafter are non-primitive, and so dynamic dispatching is forbidden.
This is an opportunity to praise GNAT's excellent warnings:

dispatch.adb:11:07: warning: no primitive operations for "General_T"
after this line
(this is the line declaring Type_A)

dispatch.adb:19:17: this primitive operation is declared too late
(this is the line declaring Put (General_T)

dispatch.adb:52:15: class-wide argument not allowed here
dispatch.adb:52:15: "Put" is not a primitive operation of "General_T"
(quite explicit when you know the language rules)

Move the declaration of Put (General_Type) before the declaration of
Type_A, and the declaration of Put (Type_A) before the declaration of
Type_B (which freezes Type_A). This will make these subprograms
primitive.

The basic idea behind freezing rules is that you cannot add a primitive
operation to the vtable of a tagged type after declaring another type
derived from it.

-- 
Ludovic Brenta.