This patch reimplements the secondary stack runtime support as follows:

   * The compiler interface remains unchanged. This applies to both types and
     subprograms used by the compiler to create and manage secondary stacks.

   * The secondary stack is no longer a doubly linked list of chunks.

   * Various allocation scenarios are now handled by the same mechanism.

In addition, the patch introduces a lightweight private interface for testing
purposes.

------------
-- Source --
------------

--  comparator.ads

generic
   type Field_Typ is private;
   --  The type of the field being compared

   with function Image (Val : Field_Typ) return String;
   --  Field-to-String converted

procedure Comparator
  (Field_Nam    : String;
   Actual_Val   : Field_Typ;
   Expected_Val : Field_Typ);
--  Compare actual value Actual_Val against expected value Expected_Val for
--  field Field_Nam. Emit an error if this is not the case.

--  comparator.adb

with Ada.Text_IO; use Ada.Text_IO;

procedure Comparator
  (Field_Nam    : String;
   Actual_Val   : Field_Typ;
   Expected_Val : Field_Typ)
is
begin
   if Actual_Val /= Expected_Val then
      Put_Line (Field_Nam);
      Put_Line ("  Actual   :" & Image (Actual_Val));
      Put_Line ("  Expected :" & Image (Expected_Val));
   end if;
end Comparator;

--  debugger.ads

package Debugger is

   Verbouse : constant Boolean := False;
   --  Set to True in order to obtain verbouse output

   procedure Output (Msg : String);
   --  Emit Msg to standard output if Verbouse is True

end Debugger;

--  debugger.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Debugger is

   ------------
   -- Output --
   ------------

   procedure Output (Msg : String) is
   begin
      if Verbouse then
         Put_Line (Msg);
      end if;
   end Output;
end Debugger;

--  s-sestte.ads

package System.Secondary_Stack.Tester is

   procedure Test_Dynamic_Stack_Dynamic_Chunks;
   --  Test various properties of a dynamic stack's dynamic chunks

   procedure Test_Dynamic_Stack_Illegal_Allocations;
   --  Test whether illegal allocations on a dynamic stack are properly
   --  detected and reported.

   procedure Test_Dynamic_Stack_Static_Chunk;
   --  Test various properties of a dynamic stack's static chunk

   procedure Test_Dynamic_Stack_Zero_Chunk_Size;
   --  Test various properties of a dynamic stack with default chunk size of
   --  zero.

   procedure Test_Static_Stack_Illegal_Allocations;
   --  Test whether illegal allocations on a static stack are properly
   --  detected and reported.

   procedure Test_Static_Stack_Overflow;
   --  Test whether overflow of a static stack's static chunk is properly
   --  detected and reported.

   procedure Test_Static_Stack_Static_Chunk;
   --  Test various properties of a static chunk's static chunk

end System.Secondary_Stack.Tester;

--  s-sestte.adb

with Ada.Assertions;          use Ada.Assertions;
with Ada.Text_IO;             use Ada.Text_IO;
with System;                  use System;
with System.Parameters;       use System.Parameters;
with System.Soft_Links;       use System.Soft_Links;
with System.Storage_Elements; use System.Storage_Elements;

with Comparator;
with Debugger;                use Debugger;

package body System.Secondary_Stack.Tester is

   Units : constant := Standard'Maximum_Alignment;
   --  Each allocation of the secondary stack is rouded up to the nearest
   --  multiple of the maximum alignment. This value is called a "unit" in
   --  order to facilitate further allocations.

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Compare_Boolean is
     new Comparator
           (Field_Typ => Boolean,
            Image     => Boolean'Image);

   procedure Compare_Chunk_Count is
     new Comparator
           (Field_Typ => Chunk_Count,
            Image     => Chunk_Count'Image);

   procedure Compare_Chunk_Id is
     new Comparator
           (Field_Typ => Chunk_Id,
            Image     => Chunk_Id'Image);

   procedure Compare_Memory_Index is
     new Comparator
           (Field_Typ => Memory_Index,
            Image     => Memory_Index'Image);

   procedure Compare_Memory_Size is
     new Comparator
           (Field_Typ => Memory_Size,
            Image     => Memory_Size'Image);

   procedure Compare_MSWI is
     new Comparator
           (Field_Typ => Memory_Size_With_Invalid,
            Image     => Memory_Size_With_Invalid'Image);

   procedure Initialize_Stack (Size : Memory_Size);
   --  Create a new secondary stack for the calling task where the default
   --  chunk size is Size.

   procedure Match_Chunk
     (Match_Nam : String;
      Actual    : Chunk_Info;
      Expected  : Chunk_Info);
   --  Check whether actual chunk info Actual matches expected chunk info
   --  Expected. Match_Nam is the name of the match.

   procedure Match_Pointer
     (Actual    : Stack_Pointer_Info;
      Expected  : Stack_Pointer_Info);
   --  Check whether actual pointer info Actual matches expected pointer info
   --  Expected.

   procedure Match_Stack
     (Match_Nam : String;
      Actual    : Stack_Info;
      Expected  : Stack_Info);
   --  Check whether actual stack info Stack matches expected stack info
   --  Expected. Match_Nam is the name of the match.

   procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size);
   --  Common testing for properties of the static chunk for both static and
   --  dynamic secondary stacks. Def_Chunk_Size denotes the default size of a
   --  secondary stack chunk. This routine assumes that the secondary stack
   --  can fit 12 * Units.

   ----------------------
   -- Initialize_Stack --
   ----------------------

   procedure Initialize_Stack (Size : Memory_Size) is
      Stack : SS_Stack_Ptr;

   begin
      --  Obtain the secondary stack of the calling task

      Stack := Get_Sec_Stack.all;

      --  If the calling task has an existing secodnary stack, destroy it
      --  because this scenario utilizes a custom secondary stack.

      if Stack /= null then

         --  Destroy the existing secondary stack because it will be replaced
         --  with a new one.

         SS_Free (Stack);
         pragma Assert (Stack = null);
      end if;

      --  Create a brand new empty secondary stack

      SS_Init (Stack, Size);
      pragma Assert (Stack /= null);

      --  Associate the secondary stack with the calling task

      Set_Sec_Stack (Stack);
   end Initialize_Stack;

   -----------------
   -- Match_Chunk --
   -----------------

   procedure Match_Chunk
     (Match_Nam : String;
      Actual    : Chunk_Info;
      Expected  : Chunk_Info)
   is
   begin
      Output (Match_Nam);

      Compare_MSWI
        ("Size",               Actual.Size,
                               Expected.Size);
      Compare_MSWI
        ("Size_Up_To_Chunk",   Actual.Size_Up_To_Chunk,
                               Expected.Size_Up_To_Chunk);
   end Match_Chunk;

   -------------------
   -- Match_Pointer --
   -------------------

   procedure Match_Pointer
     (Actual    : Stack_Pointer_Info;
      Expected  : Stack_Pointer_Info)
   is
   begin
      Compare_Memory_Index
        ("Byte",               Actual.Byte,
                               Expected.Byte);
      Compare_Chunk_Id
        ("Chunk",              Actual.Chunk,
                               Expected.Chunk);
   end Match_Pointer;

   -----------------
   -- Match_Stack --
   -----------------

   procedure Match_Stack
     (Match_Nam : String;
      Actual    : Stack_Info;
      Expected  : Stack_Info)
   is
   begin
      Output (Match_Nam);

      Compare_Memory_Size
        ("Default_Chunk_Size", Actual.Default_Chunk_Size,
                               Expected.Default_Chunk_Size);
      Compare_Boolean
        ("Freeable",           Actual.Freeable,
                               Expected.Freeable);
      Compare_Memory_Size
        ("High_Water_Mark",    Actual.High_Water_Mark,
                               Expected.High_Water_Mark);
      Compare_Chunk_Count
        ("Number_Of_Chunks",   Actual.Number_Of_Chunks,
                               Expected.Number_Of_Chunks);

      Match_Pointer (Actual.Top, Expected.Top);
   end Match_Stack;

   ---------------------------------------
   -- Test_Dynamic_Stack_Dynamic_Chunks --
   ---------------------------------------

   procedure Test_Dynamic_Stack_Dynamic_Chunks is
      Def_Chunk_Size : constant Memory_Size := 4 * Units;

      Dummy_1 : Address;
      Dummy_2 : Address;
      Dummy_3 : Address;
      Dummy_4 : Address;
      Mark    : Mark_Id;

   begin
      Output ("#### Test_DSDCs ####");

      --  Create a brand new empty secondary stack
      --
      --       1  2  3  4
      --    +------------+
      --    |            |
      --    +------------+

      Initialize_Stack (Def_Chunk_Size);

      Match_Stack
        (Match_Nam => "Empty stack",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 0,
            Number_Of_Chunks   => 1,
            Top                => (Byte => 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "Empty stack, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --       Mark
      --       |
      --       1  2  3  4
      --    +------------+
      --    |            |
      --    +------------+

      Mark := SS_Mark;

      --       Mark                           Top.Byte
      --       |                              |
      --       1  2  3  4      1  2  3  4  5  6
      --    +------------+  +---------------+
      --    |            |->|###############|
      --    +------------+  +---------------+
      --       1  2  3  4      5  6  7  8  9
      --                                   |
      --                                   HWM

      SS_Allocate (Dummy_1, 5 * Units);

      Match_Stack
        (Match_Nam => "After 5u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 9 * Units,
            Number_Of_Chunks   => 2,
            Top                => (Byte => (5 * Units) + 1, Chunk => 2)));

      Match_Chunk
        (Match_Nam => "After 5u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 5u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 5 * Units,
            Size_Up_To_Chunk => 4 * Units));

      --       Mark                                     Top.Byte
      --       |                                        |
      --       1  2  3  4      1  2  3  4  5      1  2  3  4
      --    +------------+  +---------------+  +------------+
      --    |            |->|###############|->|######      |
      --    +------------+  +---------------+  +------------+
      --       1  2  3  4      5  6  7  8  9     10 11 12 13
      --                                             |
      --                                             HWM
      --
      --  Note that the size of Chunk 3 defaults to 4 because the request is
      --  smaller than the default chunk size.

      SS_Allocate (Dummy_2, 2 * Units);

      Match_Stack
        (Match_Nam => "After 2u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 3,
            Top                => (Byte => (2 * Units) + 1, Chunk => 3)));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 5 * Units,
            Size_Up_To_Chunk => 4 * Units));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 3",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 3),
         Expected  =>
           (Size             => 4 * Units,
            Size_Up_To_Chunk => 9 * Units));

      --       Top.Byte
      --       |
      --       1  2  3  4         1  2  3  4  5         1  2  3  4
      --    +------------+     +---------------+     +------------+
      --    |            | --> |###############| --> |######      |
      --    +------------+     +---------------+     +------------+
      --       1  2  3  4         5  6  7  8  9        10 11 12 13
      --                                                   |
      --                                                   HWM

      SS_Release (Mark);

      --                Top.Byte
      --                |
      --       1  2  3  4         1  2  3  4  5         1  2  3  4
      --    +------------+     +---------------+     +------------+
      --    |#########   | --> |###############| --> |######      |
      --    +------------+     +---------------+     +------------+
      --       1  2  3  4         5  6  7  8  9         10 11 12 13
      --                                                   |
      --                                                   HWM

      SS_Allocate (Dummy_3, 3 * Units);

      Match_Stack
        (Match_Nam => "After 3u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 3,
            Top                => (Byte => (3 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After 3u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 3u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 5 * Units,
            Size_Up_To_Chunk => 4 * Units));

      Match_Chunk
        (Match_Nam => "After 3u allocation, chunk 3",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 3),
         Expected  =>
           (Size             => 4 * Units,
            Size_Up_To_Chunk => 9 * Units));

      --                                                  Top.Byte
      --                                                  |
      --       1  2  3  4         1  2  3  4  5  6  7  8  9
      --    +------------+     +------------------------+
      --    |#########   | --> |########################|
      --    +------------+     +------------------------+
      --       1  2  3  4         5  6  7  8  9 10 11 12
      --                                               |
      --                                               HWM

      SS_Allocate (Dummy_4, 8 * Units);

      Match_Stack
        (Match_Nam => "After 8u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 12 * Units,
            Number_Of_Chunks   => 2,
            Top                => (Byte => (8 * Units) + 1, Chunk => 2)));

      Match_Chunk
        (Match_Nam => "After 8u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 8u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 8 * Units,
            Size_Up_To_Chunk => 4 * Units));

   exception
      when others =>
         Put_Line ("Test_DSDCs: unexpected exception");
   end Test_Dynamic_Stack_Dynamic_Chunks;

   --------------------------------------------
   -- Test_Dynamic_Stack_Illegal_Allocations --
   --------------------------------------------

   procedure Test_Dynamic_Stack_Illegal_Allocations is
      Def_Chunk_Size : constant Memory_Size := 4 * Units;

      Dummy_1 : Address;
      Dummy_2 : Address;

   begin
      Output ("#### Test_DSIA ####");

      --  Create a brand new empty secondary stack
      --
      --       1  2  3  4
      --    +------------+
      --    |            |
      --    +------------+

      Initialize_Stack (Def_Chunk_Size);

      Match_Stack
        (Match_Nam => "Empty stack",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 0,
            Number_Of_Chunks   => 1,
            Top                => (Byte => 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "Empty stack, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --  It should not be possible to allocate an object of size zero

      Zero_Allocation : begin
         SS_Allocate (Dummy_1, 0);
         Put_Line ("Test_DSIA: ERROR: zero allocation succeeded");

      exception
         when Assertion_Error =>
            Match_Stack
              (Match_Nam => "After zero allocation",
               Actual    => Get_Stack_Info (Get_Sec_Stack.all),
               Expected  =>
                 (Default_Chunk_Size => Def_Chunk_Size,
                  Freeable           => True,
                  High_Water_Mark    => 0,
                  Number_Of_Chunks   => 1,
                  Top                => (Byte => 1, Chunk => 1)));

            Match_Chunk
              (Match_Nam => "After zero allocation",
               Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
               Expected  =>
                 (Size             => Def_Chunk_Size,
                  Size_Up_To_Chunk => 0));

         when others =>
            Put_Line ("Test_DSIA: zero allocation: unexpected exception");
      end Zero_Allocation;

      --  It should not be possible to allocate an object of negative size

      Negative_Allocation : begin
         SS_Allocate (Dummy_2, -8);
         Put_Line ("Test_DSIA: ERROR: negative allocation succeeded");

      exception
         when Assertion_Error =>
            Match_Stack
              (Match_Nam => "After negative allocation",
               Actual    => Get_Stack_Info (Get_Sec_Stack.all),
               Expected  =>
                 (Default_Chunk_Size => Def_Chunk_Size,
                  Freeable           => True,
                  High_Water_Mark    => 0,
                  Number_Of_Chunks   => 1,
                  Top                => (Byte => 1, Chunk => 1)));

            Match_Chunk
              (Match_Nam => "After negative allocation",
               Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
               Expected  =>
                 (Size             => Def_Chunk_Size,
                  Size_Up_To_Chunk => 0));

         when others =>
            Put_Line ("Test_DSIA: negative allocation: unexpected exception");
      end Negative_Allocation;

   exception
      when others =>
         Put_Line ("Test_DSIA: unexpected exception");
   end Test_Dynamic_Stack_Illegal_Allocations;

   -------------------------------------
   -- Test_Dynamic_Stack_Static_Chunk --
   -------------------------------------

   procedure Test_Dynamic_Stack_Static_Chunk is
      Def_Chunk_Size : constant Memory_Size := 12 * Units;

      Dummy_1 : Address;
      Dummy_2 : Address;
      Dummy_3 : Address;
      Dummy_4 : Address;
      Mark_1  : Mark_Id;
      Mark_2  : Mark_Id;

   begin
      Output ("#### Test_DSSC ####");

      --  Create a brand new empty secondary stack
      --
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------+
      --    |                                    |
      --    +------------------------------------+

      Initialize_Stack  (Def_Chunk_Size);
      Test_Static_Chunk (Def_Chunk_Size);

   exception
      when others =>
         Put_Line ("Test_DSSC: unexpected exception");
   end Test_Dynamic_Stack_Static_Chunk;

   ----------------------------------------
   -- Test_Dynamic_Stack_Zero_Chunk_Size --
   ----------------------------------------

   procedure Test_Dynamic_Stack_Zero_Chunk_Size is
      Def_Chunk_Size : constant Memory_Size := 0;

      Dummy_1 : Address;
      Dummy_2 : Address;
      Mark    : Mark_Id;

   begin
      Output ("#### Test_DSZCS ####");

      --  Create a brand new empty secondary stack
      --
      --    ++
      --    ||
      --    ++

      Initialize_Stack (Def_Chunk_Size);

      Match_Stack
        (Match_Nam => "Empty stack",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 0,
            Number_Of_Chunks   => 1,
            Top                => (Byte => 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "Empty stack, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --       Mark
      --       |
      --       1
      --    ++
      --    ||
      --    ++

      Mark := SS_Mark;

      --       Mark         Top.Byte
      --       |            |
      --       |   1  2  3  4
      --    ++  +---------+
      --    ||->|#########|
      --    ++  +---------+
      --           1  2  3
      --                 |
      --                 HWM

      SS_Allocate (Dummy_1, 3 * Units);

      Match_Stack
        (Match_Nam => "After 3u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 3 * Units,
            Number_Of_Chunks   => 2,
            Top                => (Byte => (3 * Units) + 1, Chunk => 2)));

      Match_Chunk
        (Match_Nam => "After 3u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 3u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 3 * Units,
            Size_Up_To_Chunk => 0));

      --       Mark                   Top.Byte
      --       |                      |
      --       |   1  2  3      1  2  3
      --    ++  +---------+  +------+
      --    ||->|#########|->|######|
      --    ++  +---------+  +------+
      --           1  2  3      4  5
      --                           |
      --                           HWM

      SS_Allocate (Dummy_2, 2 * Units);

      Match_Stack
        (Match_Nam => "After 2u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 5 * Units,
            Number_Of_Chunks   => 3,
            Top                => (Byte => (2 * Units) + 1, Chunk => 3)));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 3 * Units,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 3",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 3),
         Expected  =>
           (Size             => 2 * Units,
            Size_Up_To_Chunk => 3 * Units));

      --       Top.Byte
      --       |
      --       |   1  2  3      1  2
      --    ++  +---------+  +------+
      --    ||->|#########|->|######|
      --    ++  +---------+  +------+
      --           1  2  3      4  5
      --                           |
      --                           HWM

      SS_Release (Mark);

      --                             Top.Byte
      --                             |
      --           1  2  3  4  5  6  7
      --    ++  +------------------+
      --    ||->|##################|
      --    ++  +------------------+
      --           1  2  3  4  5  6
      --                          |
      --                          HWM

      SS_Allocate (Dummy_2, 6 * Units);

      Match_Stack
        (Match_Nam => "After 6u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 6 * Units,
            Number_Of_Chunks   => 2,
            Top                => (Byte => (6 * Units) + 1, Chunk => 2)));

      Match_Chunk
        (Match_Nam => "After 6u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      Match_Chunk
        (Match_Nam => "After 6u allocation, chunk 2",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 2),
         Expected  =>
           (Size             => 6 * Units,
            Size_Up_To_Chunk => 0));

   exception
      when others =>
         Put_Line ("Test_DSZCS: unexpected exception");
   end Test_Dynamic_Stack_Zero_Chunk_Size;

   -----------------------
   -- Test_Static_Chunk --
   -----------------------

   procedure Test_Static_Chunk (Def_Chunk_Size : Memory_Size) is
      Dummy_1 : Address;
      Dummy_2 : Address;
      Dummy_3 : Address;
      Dummy_4 : Address;
      Mark_1  : Mark_Id;
      Mark_2  : Mark_Id;

   begin
      --  This routine assumes an empty secondary stack

      Match_Stack
        (Match_Nam => "Empty stack",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 0,
            Number_Of_Chunks   => 1,
            Top                => (Byte => 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "Empty stack, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                   Top.Byte
      --                   |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |############
      --    +------------------------------------. . .
      --                |
      --                HWM

      SS_Allocate (Dummy_1, 4 * Units);

      Match_Stack
        (Match_Nam => "After 4u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 4 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (4 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After 4u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                   Mark_1
      --                   Top.Byte
      --                   |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |############
      --    +------------------------------------. . .
      --                |
      --                HWM

      Mark_1 := SS_Mark;

      --                   Mark_1
      --                   |              Top.Byte
      --                   |              |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |###########################
      --    +------------------------------------. . .
      --                               |
      --                               HWM

      SS_Allocate (Dummy_2, 5 * Units);

      Match_Stack
        (Match_Nam => "After 5u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 9 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (9 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After 5u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                   Mark_1         Mark_2
      --                   |              Top.Byte
      --                   |              |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |###########################
      --    +------------------------------------. . .
      --                               |
      --                               HWM

      Mark_2 := SS_Mark;

      --                   Mark_1         Mark_2
      --                   |              |     Top.Byte
      --                   |              |     |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |#################################
      --    +------------------------------------. . .
      --                                     |
      --                                     HWM

      SS_Allocate (Dummy_3, 2 * Units);

      Match_Stack
        (Match_Nam => "After 2u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (11 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After 2u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                   Mark_1
      --                   |              Top.Byte
      --                   |              |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |#################################
      --    +------------------------------------. . .
      --                                     |
      --                                     HWM

      SS_Release (Mark_2);

      Match_Stack
        (Match_Nam => "After Mark_2 release",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (9 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After Mark_2 release, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                   Top.Byte
      --                   |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |#################################
      --    +------------------------------------. . .
      --                                     |
      --                                     HWM

      SS_Release (Mark_1);

      Match_Stack
        (Match_Nam => "After Mark_1 release",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (4 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After Mark_1 release, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));

      --                                        Top.Byte
      --                                        |
      --       1  2  3  4  5  6  7  8  9 10 11 12
      --    +------------------------------------. . .
      --    |#################################
      --    +------------------------------------. . .
      --                                     |
      --                                     HWM

      SS_Allocate (Dummy_4, 6 * Units);

      Match_Stack
        (Match_Nam => "After 6u allocation",
         Actual    => Get_Stack_Info (Get_Sec_Stack.all),
         Expected  =>
           (Default_Chunk_Size => Def_Chunk_Size,
            Freeable           => True,
            High_Water_Mark    => 11 * Units,
            Number_Of_Chunks   => 1,
            Top                => (Byte => (10 * Units) + 1, Chunk => 1)));

      Match_Chunk
        (Match_Nam => "After 6u allocation, chunk 1",
         Actual    => Get_Chunk_Info (Get_Sec_Stack.all, 1),
         Expected  =>
           (Size             => Def_Chunk_Size,
            Size_Up_To_Chunk => 0));
   end Test_Static_Chunk;

   -------------------------------------------
   -- Test_Static_Stack_Illegal_Allocations --
   -------------------------------------------

   procedure Test_Static_Stack_Illegal_Allocations is
      Dummy_1 : Address;
      Dummy_2 : Address;

   begin
      Output ("#### Test_SSIA ####");

      --  It should not be possible to allocate an object of size zero

      Zero_Allocation : begin
         SS_Allocate (Dummy_1, 0);
         Put_Line ("Test_SSIA: ERROR: zero allocation succeeded");

      exception
         when Assertion_Error =>
            Output ("After zero allocation");

         when others =>
            Put_Line ("Test_SSIA: zero allocation: unexpected exception");
      end Zero_Allocation;

      --  It should not be possible to allocate an object of negative size

      Negative_Allocation : begin
         SS_Allocate (Dummy_2, -8);
         Put_Line ("Test_SSIA: ERROR: negative allocation succeeded");

      exception
         when Assertion_Error =>
            Output ("After negative allocation");

         when others =>
            Put_Line ("Test_SSIA: negative allocation: unexpected exception");
      end Negative_Allocation;

   exception
      when others =>
         Put_Line ("Test_SSIA: unexpected exception");
   end Test_Static_Stack_Illegal_Allocations;

   --------------------------------
   -- Test_Static_Stack_Overflow --
   --------------------------------

   procedure Test_Static_Stack_Overflow is
      Info  : constant Stack_Info := Get_Stack_Info (Get_Sec_Stack.all);
      Dummy : Address;

   begin
      Output ("#### Test_SSO ####");

      --  Try to overflow the static chunk

      Overflow : begin
         SS_Allocate (Dummy, Storage_Offset (Info.Default_Chunk_Size));
         Put_Line ("Test_SSO: ERROR: Overflow not detected");

      exception
         when Storage_Error =>
            Output ("After overflow");

         when others =>
            Put_Line ("Test_SSO: overflow: unexpected exception");
      end Overflow;

   exception
      when others =>
         Put_Line ("Test_SSO: unexpected exception");
   end Test_Static_Stack_Overflow;

   ------------------------------------
   -- Test_Static_Stack_Static_Chunk --
   ------------------------------------

   procedure Test_Static_Stack_Static_Chunk is
      Info : Stack_Info;

   begin
      Output ("#### Test_SSSC ####");

      Info := Get_Stack_Info (Get_Sec_Stack.all);
      Test_Static_Chunk (Info.Default_Chunk_Size);

   exception
      when others =>
         Put_Line ("Test_SSSC: unexpected exception");
   end Test_Static_Stack_Static_Chunk;

end System.Secondary_Stack.Tester;

--  main.adb

with Ada.Text_IO;                   use Ada.Text_IO;
with System.Parameters;             use System.Parameters;
with System.Secondary_Stack.Tester; use System.Secondary_Stack.Tester;

procedure Main is
   task Tester;

   --  The various scenarios are tested within a task because this guarantees
   --  that on a normal compilation, the task's secondary stack is created on
   --  the heap and can be safely freed and replaced with a custom one.

   task body Tester is
   begin
      if Sec_Stack_Dynamic then
         Test_Dynamic_Stack_Static_Chunk;
         Test_Dynamic_Stack_Dynamic_Chunks;
         Test_Dynamic_Stack_Zero_Chunk_Size;
         Test_Dynamic_Stack_Illegal_Allocations;
      else
         Test_Static_Stack_Static_Chunk;
         Test_Static_Stack_Overflow;
         Test_Static_Stack_Illegal_Allocations;
      end if;
   end Tester;

begin null; end Main;

-----------------
-- Compilation --
-----------------

$ gnatmake -a -f -q -gnata -gnatws main.adb
$ ./main

2018-05-30  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* libgnat/s-secsta.adb: Reimplement the secondary stack support.
	* libgnat/s-secsta.ads: Update the documentation of all routines in the
	public part of the package.  Reimplement the private part of the
	package to account for the new secondary stack structure.  Add types
	and subprograms for testing purposes.  Add several documentation
	sections.

From-SVN: r260924