Re: Limited_Controlled and constructor functions

[Gautier <gautier@fakeaddress.nil>]

Oh, and a version without implicit dynamic allocation at all:

--8<-----------8<-----------8<-----------8<-----------8<-----------8<---------
pragma Ada_83;

with Text_IO, Variant_pkg;

procedure Variants is
   use Variant_pkg;

   P : constant Params := (Param("Hello"),
                           Param("Ada"),
                           Param(12),
                           Param(3.14));
begin
   for i in P'Range loop
     Text_IO.Put_Line(
       "Parameter #" & Integer'Image(i) & ": [" & Image(P(i)) & ']'
     );
   end loop;
end Variants;
--8<-----------8<-----------8<-----------8<-----------8<-----------8<---------
package Variant_pkg is

   type BorString( maxlength: Positive ) is record
     length: Natural:= 0;
     s: String( 1..maxlength );
   end record;

   type Kind is (A_String, An_Integer, A_Float);

   xamax: constant:= 1024;

   type Atom(k: Kind:= An_Integer) is record
     case k is
       when A_String   => s: BorString(xamax);
       when An_Integer => i: Integer;
       when A_Float    => f: Float;
     end case;
   end record;

   type Params is array(Positive range <>) of Atom;

   function Param(s: String) return Atom;
   function Param(i: Integer) return Atom;
   function Param(f: Float) return Atom;

   function Image(a: Atom) return String;

end Variant_pkg;
--8<-----------8<-----------8<-----------8<-----------8<-----------8<---------
package body Variant_pkg is

   function Param(s: String) return Atom is
     a: Atom(A_String);
   begin
     a.s.s(1..s'Length):= s;
     a.s.length:= s'Length;
     return a;
   end Param;

   function Param(i: Integer) return Atom is
   begin
     return Atom'(k => An_Integer, i => i);
   end Param;

   function Param(f: Float) return Atom is
   begin
     return Atom'(k => A_Float, f => f);
   end Param;

   function Image(a: Atom) return String is
   begin
     case a.k is
       when A_String   => return a.s.s(1..a.s.length);
       when An_Integer => return Integer'Image(a.i);
       when A_Float    => return Float'Image(a.f);
     end case;
   end Image;

end Variant_pkg;