b2_growable_stack.adb

with ada.Text_IO; use ada.Text_IO;


package body b2_growable_Stack
is

   package body b2GrowableStack
   is
      use ada.Containers;


      function to_Stack return Stack
      is
         Self : Stack;
      begin
         put_Line ("to_Stack ~ Initial Capacity:" & initial_Capacity'Image);
         put_Line ("to_Stack ~ Before reserve:  "    & Self.Capacity'Image);

         Self.reserve_Capacity (Count_type (initial_Capacity));

         put_Line ("to_Stack ~ After reserve:   "    & Self.Capacity'Image);

         return Self;
      end to_Stack;



      procedure setCapacity (Self : in out Stack;   To : in Natural)
      is
      begin
         Self.reserve_Capacity (Count_type (To));
      end setCapacity;



      procedure push (Self : in out Stack;   E : in Element_T)
      is
         pragma assert (Check   => Self.Capacity >= Count_type (initial_Capacity),
                        Message => "Stack has not been initialised.   " & Self.Capacity'Image & initial_Capacity'Image);
      begin
         Self.append (E);
      end push;



      function pop (Self : in out Stack) return Element_T
      is
         Top : constant Element_t := Self.last_Element;
      begin
         Self.delete_Last;
         return Top;
      end pop;



      function getCount (Self : in  Stack)   return Natural
      is
      begin
         return Natural (Self.Length);
      end getCount;



      function getCapacity (Self : in  Stack)   return Natural
      is
      begin
         return Natural (Self.Capacity);
      end getCapacity;


   end b2GrowableStack;


end b2_growable_Stack;

b2_growable_stack.ads

private
with
     ada.Containers.Vectors;


package b2_growable_Stack
is

   generic
      type Element_t is private;
      initial_Capacity : Positive;

   package b2GrowableStack
   is
      type Stack is private;

      function  to_Stack return Stack;


      procedure push (Self : in out Stack;   E : in Element_T);
      function  pop  (Self : in out Stack)   return Element_T;


      function  getCount    (Self : in  Stack)       return Natural;
      function  getCapacity (Self : in  Stack)       return Natural;

      procedure setCapacity (Self : in out Stack;   To : in Natural);


   private
      package Vectors is new ada.Containers.Vectors (Positive, Element_t);
      type    Stack   is new Vectors.Vector with null record;

   end b2GrowableStack;


end b2_growable_Stack;

stack_bug.adb

with
     b2_growable_Stack,
     ada.Text_IO;


procedure stack_Bug
is
   use b2_growable_Stack,
       ada.Text_IO;


   package natural_Stacks is new b2GrowableStack (Natural, 256);
   use     natural_Stacks;

   subtype natural_Stack is natural_Stacks.Stack;

   Stack : constant natural_Stack := to_Stack;

begin
   put_Line ("stack_Bug ~ Actual Capacity:" & getCapacity (Stack)'Image);
end stack_Bug;