This was forgotten when renaming Get_Package_Instantiation_Node to
Get_Unit_Instantiation_Node.

2018-05-30  Piotr Trojanek  <trojanek@adacore.com>

gcc/ada/

	* einfo.ads (Package_Instantiation): Update comment after a routine
	that uses this field has been renamed.

From-SVN: r260950

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch11.adb (Replace_Raise_By_Goto): The transfomation is legal even
	if the local raise statement includes a string expression. This
	expression might be picked up by an outer handler or discarded, but
	plays no role in this transformation.

From-SVN: r260949

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

gcc/ada/

	* exp_aggr.adb, exp_unst.adb, freeze.adb, libgnat/a-direct.adb: Minor
	reformatting.

From-SVN: r260948

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node): Handle the semantic Procedure_To_Call
	field in relevant nodes: Allocate, Free, and return statements.

From-SVN: r260947

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node): Do not traverse a Component_Association
	that has not been analyzed, as will be the case for a nested aggregate
	that is expanded into individual assignments.

From-SVN: r260946

This patch implements AI12-0164-1 for the aspect/pragma Max_Entry_Queue_Depth.
Previously, the GNAT specific pragma Max_Queue_Length fulfilled this role, but
was not named to match the standard and thus was insufficent.

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

--  pass.ads

with System;
package Pass is

   SOMETHING : constant Integer := 5;
   Variable : Boolean := False;

   protected type Protected_Example is

      entry A (Item : Integer)
         with Max_Entry_Queue_Depth => 2;            --  OK

      entry B (Item : Integer);
      pragma Max_Entry_Queue_Depth (SOMETHING);      --  OK

      entry C (Item : Integer);                      --  OK

      entry D (Item : Integer)
         with Max_Entry_Queue_Depth => 4;            --  OK

      entry D (Item : Integer; Item_B : Integer)
         with Max_Entry_Queue_Depth => Float'Digits; --  OK

      entry E (Item : Integer);
      pragma Max_Entry_Queue_Depth (SOMETHING * 2);  --  OK

      entry E (Item : Integer; Item_B : Integer);
      pragma Max_Entry_Queue_Depth (11);             --  OK

      entry F (Item : Integer; Item_B : Integer);
      pragma Pre (Variable = True);
      pragma Max_Entry_Queue_Depth (11);             --  OK

      entry G (Item : Integer; Item_B : Integer)
         with Pre => (Variable = True),
              Max_Entry_Queue_Depth => 11;           --  OK

   private
      Data : Boolean := True;
   end Protected_Example;

   Prot_Ex  : Protected_Example;

end Pass;

--  fail.ads

package Fail is

   --  Not near entry

   pragma Max_Entry_Queue_Depth (40);                                --  ERROR

   --  Task type

   task type Task_Example is

      entry Insert (Item : in Integer)
         with Max_Entry_Queue_Depth => 10;                           --  ERROR

      -- Entry family in task type

      entry A (Positive) (Item : in Integer)
         with Max_Entry_Queue_Depth => 10;                           --  ERROR

   end Task_Example;

   Task_Ex : Task_Example;

   --  Aspect applied to protected type

   protected type Protected_Failure_0
      with Max_Entry_Queue_Depth => 50 is                            --  ERROR

      entry A (Item : Integer);
   private
      Data : Integer := 0;
   end Protected_Failure_0;

   Protected_Failure_0_Ex : Protected_Failure_0;

   protected type Protected_Failure is
      pragma Max_Entry_Queue_Depth (10);                             --  ERROR

      --  Duplicates

      entry A (Item : Integer)
         with Max_Entry_Queue_Depth => 10;                           --  OK
      pragma Max_Entry_Queue_Depth (4);                              --  ERROR

      entry B (Item : Integer);
      pragma Max_Entry_Queue_Depth (40);                             --  OK
      pragma Max_Entry_Queue_Depth (4);                              --  ERROR

      entry C (Item : Integer)
         with Max_Entry_Queue_Depth => 10,                           --  OK
              Max_Entry_Queue_Depth => 40;                           --  ERROR

      -- Duplicates with the same value

      entry AA (Item : Integer)
         with Max_Entry_Queue_Depth => 10;                           --  OK
      pragma Max_Entry_Queue_Depth (10);                             --  ERROR

      entry BB (Item : Integer);
      pragma Max_Entry_Queue_Depth (40);                             --  OK
      pragma Max_Entry_Queue_Depth (40);                             --  ERROR

      entry CC (Item : Integer)
         with Max_Entry_Queue_Depth => 10,                           --  OK
              Max_Entry_Queue_Depth => 10;                           --  ERROR

      --  On subprogram

      procedure D (Item : Integer)
         with Max_Entry_Queue_Depth => 10;                           --  ERROR

      procedure E (Item : Integer);
      pragma Max_Entry_Queue_Depth (4);                              --  ERROR

      function F (Item : Integer) return Integer
         with Max_Entry_Queue_Depth => 10;                           --  ERROR

      function G (Item : Integer) return Integer;
      pragma Max_Entry_Queue_Depth (4);                              --  ERROR

      --  Bad parameters

      entry H (Item : Integer)
         with Max_Entry_Queue_Depth => 0;                            --  ERROR

      entry I (Item : Integer)
         with Max_Entry_Queue_Depth => -1;                           --  ERROR

      entry J (Item : Integer)
         with Max_Entry_Queue_Depth => 16#FFFF_FFFF_FFFF_FFFF_FFFF#; --  ERROR

      entry K (Item : Integer)
         with Max_Entry_Queue_Depth => False;                        --  ERROR

      entry L (Item : Integer)
         with Max_Entry_Queue_Depth => "JUNK";                       --  ERROR

      entry M (Item : Integer)
         with Max_Entry_Queue_Depth => 1.0;                          --  ERROR

      entry N (Item : Integer)
         with Max_Entry_Queue_Depth => Long_Integer'(3);             --  ERROR

      -- Entry family

      entry O (Boolean) (Item : Integer)
         with Max_Entry_Queue_Depth => 5;                            --  ERROR

   private
      Data : Integer := 0;
   end Protected_Failure;

   I : Positive := 1;

   Protected_Failure_Ex : Protected_Failure;

end Fail;

--  dtest.adb

with Ada.Text_IO; use Ada.Text_IO;

procedure Dtest is
   protected Prot is
      entry Wait;
        pragma Max_Entry_Queue_Depth (2);
      procedure Wakeup;
   private
      Barrier : Boolean := False;
   end Prot;

   protected body Prot is
      entry Wait when Barrier is
      begin
         null;
      end Wait;

      procedure Wakeup is
      begin
         Barrier := True;
      end Wakeup;
   end Prot;

   task type T;

   task body T is
   begin
      Put_Line ("Waiting...");
      Prot.Wait;
   exception
      when others =>
         Put_Line ("Got exception");
   end T;

   T1, T2 : T;
begin
   delay 0.1;

   Prot.Wait;
   Put_Line ("Done");
exception
   when others =>
      Put_Line ("Main got exception");
      Prot.Wakeup;
end Dtest;

----------------------------
-- Compilation and output --
----------------------------

& gcc -c -g -gnatDG pass.ads
& gcc -c -g fail.ads
& grep -c "(2, 5, 0, 4, 6, 10, 11, 11, 11)" pass.ads.dg
& gnatmake -g -q dtest
fail.ads:5:04: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:12:15: aspect "Max_Queue_Length" cannot apply to task entries
fail.ads:17:15: aspect "Max_Queue_Length" cannot apply to task entries
fail.ads:26:12: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:36:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:42:07: pragma "Max_Queue_Length" duplicates aspect declared at line 41
fail.ads:46:07: pragma "Max_Queue_Length" duplicates pragma declared at line 45
fail.ads:50:15: aspect "Max_Queue_Length" for "C" previously given at line 49
fail.ads:56:07: pragma "Max_Queue_Length" duplicates aspect declared at line 55
fail.ads:60:07: pragma "Max_Queue_Length" duplicates pragma declared at line 59
fail.ads:64:15: aspect "Max_Queue_Length" for "CC" previously given at line 63
fail.ads:69:15: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:72:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:75:15: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:78:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:83:35: entity for aspect "Max_Queue_Length" must be positive
fail.ads:86:35: entity for aspect "Max_Queue_Length" must be positive
fail.ads:89:35: entity for aspect "Max_Queue_Length" out of range of Integer
fail.ads:92:35: expected an integer type
fail.ads:92:35: found type "Standard.Boolean"
fail.ads:95:35: expected an integer type
fail.ads:95:35: found a string type
fail.ads:98:35: expected an integer type
fail.ads:98:35: found type universal real

2018-05-30  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* aspects.adb, aspects.ads: Register new aspect.
	* par-prag.adb (Prag): Register new pragma.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Add processing for new
	aspect similar to Aspect_Max_Queue_Length.
	* sem_prag.adb, sem_prag.ads (Analyze_Pragma): Register new pragma and
	set it to use the same processing as Pragma_Max_Queue_Length.
	* snames.ads-tmpl: Move definition of Name_Max_Entry_Queue_Depth so
	that it can be processed as a pragma in addition to a restriction and
	add an entry for the pragma itself.

From-SVN: r260945

This patch allows the GNAT-specific Thread_Local_Storage to be applied
to variables of a composite type initiallized with an aggregate with
static components that requires no elaboration code.

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage
	is now legal on a variable of composite type initialized with an
	aggregate that is fully static and requires no elaboration code.
	* exp_aggr.adb (Convert_To_Positional): Recognize additional cases of
	nested aggregates that are compile-time static, so they can be used to
	initialize variables declared with Threqd_Local_Storage.
	* doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on
	Thread_Local_Storage.
	* gnat_rm.texi: Regenerate.

gcc/testsuite/

	* gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase.

From-SVN: r260944

In the modes for static analysis with CodePeer or formal verification with
GNATprove, the value of Assertion_Policy for a given policy is ignored if
it's not Disable, as CodePeer/GNATprove are meant to check assertions even
when not enabled at run time. This was not done consistently, which could
lead to spurious errors on policy mismatch on ghost code inside assertions.

There is no impact on compilation.

2018-05-30  Yannick Moy  <moy@adacore.com>

gcc/ada/

	* sem_util.adb (Policy_In_Effect): Take into account CodePeer and
	GNATprove modes.

From-SVN: r260943

Implement a missing portion of Ada 2005's AI05-0049-1 for subprogram
Ada.Directories.Name_Case_Equivalence so that user programs can account for
operating system differences in case sensitivity.

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

--  main.adb

with Ada.Directories; use Ada.Directories;
with Ada.Text_IO;     use Ada.Text_IO;
procedure Main is
begin

  --  Directory layout:
  --     /empty +-- Nothing...
  --
  --     /mutliplefiles +-- "TEST1.TXT"
  --                    |
  --                "test1.txt"
  --
  --     /singlefile +-- "test1.txt"
  --
  --     /noncasable +-- "!"
  --

  Put_Line (Name_Case_Equivalence ("./empty")'Image);
  Put_Line (Name_Case_Equivalence ("./multiplefiles")'Image);
  Put_Line (Name_Case_Equivalence ("./singlefile")'Image);
  Put_Line (Name_Case_Equivalence ("./multiplefiles/test1.txt")'Image);
  Put_Line (Name_Case_Equivalence ("./singlefile/test1.txt")'Image);
  Put_Line (Name_Case_Equivalence ("./noncaseable/!")'Image);
end;

----------------------------
-- Compilation and Output --
----------------------------

& gnatmake -q main.adb
& main
CASE_SENSITIVE
CASE_SENSITIVE
CASE_SENSITIVE
CASE_SENSITIVE
CASE_SENSITIVE
CASE_SENSITIVE

2018-05-30  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* libgnat/a-direct.adb, libgnat/a-direct.ads (Name_Case_Equivalence):
	Add implementation.
	(Start_Search): Modify to use Start_Search_Internal
	(Start_Search_Internal): Add to break out an extra flag for searching
	case insensative due to the potential for directories within the same
	OS to allow different casing schemes.
	* sysdep.c (__gnat_name_case_equivalence): Add as a default fallback
	for when the more precise solution fails.

From-SVN: r260942

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

gcc/ada/

	* checks.adb, exp_ch5.adb, exp_ch7.adb, exp_unst.adb, sem_eval.adb:
	Minor reformatting.

From-SVN: r260941

Add support for Define_Switch with a callback in GNAT.Command_Line.

The callback is called for every instance of the switch found on the
command line. This make it possible to have full control over the
switch value and chain multiple actions if needed.

2018-05-30  Pascal Obry  <obry@adacore.com>

gcc/ada/

	* libgnat/g-comlin.ads (Value_Callback, Define_Switch): New.
	* libgnat/g-comlin.adb: Add corresponding implementation.

From-SVN: r260940

2018-05-30  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* sem_res.adb, sem_util.adb: Fix several typos.

From-SVN: r260939

Temporary change for experimental purposes. Further cleanups will
be needed if this sheme works as we hope.

2018-05-30  Olivier Hainque  <hainque@adacore.com>

gcc/ada/

	* vx_crtbegin_attr.c (CTOR_ATTRIBUTE, DTOR_ATTRIBUTE): Empty.
	(eh_registration_ctors, eh_registration_tors): New static variables,
	forced in a .ctors/.dtors section, respectively, with priority.

From-SVN: r260938

2018-05-30  Bob Duff  <duff@adacore.com>

gcc/ada/

	* aspects.ads, contracts.adb, exp_util.adb, expander.adb, expander.ads,
	freeze.adb, inline.adb, lib-xref.adb, sem.ads, sem_aggr.adb,
	sem_attr.adb, sem_ch13.adb, sem_ch3.adb, sem_ch5.adb, sem_ch6.adb,
	sem_ch8.adb, sem_dim.adb, sem_elab.adb, sem_res.adb, sem_res.ads,
	sinfo.ads: Spell preanalysis, preanalyze correctly.

From-SVN: r260937

2018-05-30  Bob Duff  <duff@adacore.com>

gcc/ada/

	* libgnat/g-sestin.ads: Rework documentation comments.

From-SVN: r260936

Use a high-level Is_Rewrite_Substitution instead of a low-level inequality,
with the intention to improve the code easier to read. Semantics unaffected,
so no test provided.

2018-05-30  Piotr Trojanek  <trojanek@adacore.com>

gcc/ada/

	* errout.adb, exp_aggr.adb, exp_ch7.adb, exp_util.adb, lib.adb,
	sem_ch13.adb, sem_ch4.adb, sem_res.adb, sem_util.adb
	(Has_Original_Node): Refactor to use Is_Rewrite_Substitution.

From-SVN: r260935

Checking "Original_Node (N) /= N" is equivalent to "Is_Rewrite_Substitution
(N)", which is checked just two lines before. Trivial simplification,
semantics unaffected.

2018-05-30  Piotr Trojanek  <trojanek@adacore.com>

gcc/ada/

	* sem_prag.adb (Analyze_Pragma): Remove conjuncts that are always true.

From-SVN: r260934

This patch corrects the predicate which determines whether an entity denotes a
synchronized object as per SPARK RM 9.1. to account for a case where the object
is not atomic, but its type is.

The patch also cleans up various atomic object-related predicates.

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

gcc/ada/

	* sem_util.adb (Is_Atomic_Object): Cleaned up. Split the entity logic
	in a separate routine.
	(Is_Atomic_Object_Entity): New routine.
	(Is_Atomic_Prefix): Cleaned up.
	(Is_Synchronized_Object): Check that the object is atomic, or its type
	is atomic.
	(Object_Has_Atomic_Components): Removed.
	* sem_util.ads (Is_Atomic_Object): Reword the comment on usage.
	(Is_Atomic_Object_Entity): New routine.

gcc/testsuite/

	* gnat.dg/synchronized1.adb, gnat.dg/synchronized1.ads: New testcase.

From-SVN: r260933

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Access_Subprogram_Declaration): The flag
	Needs_Activation_Record is only needed on a subprogram type, not on a
	pointer to such.
	* sem_res.adb (Resolve_Selected_Component): If the context type and the
	component type are anonymous access to subprograms, use the component
	type to obtain the proper value of Needs_Activation_Record flag for the
	expression.

From-SVN: r260932

2018-05-30  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Add
	comment about the memset case.

From-SVN: r260931

This patch fixes a memory leak bug. In particular, in a loop of the form "for X
of ...", with a type that has the Iterable aspect specified, if the result of
the Element function is returned on the secondary stack (e.g. the result
subtype has caller-unknown size), then memory for the secondary stack could
leak.

2018-05-30  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Remove the code
	to analyze the Elmt_Decl, because it gets analyzed in the wrong scope.
	We need to analyze it as part of analyzing the block, so that if the
	call to Element that initializes Elmt_Decl returns on the secondary
	stack, the block will ss_mark/ss_release. This block is inside the
	loop; we don't want to leak memory until the loop exits.  The purpose
	of analyzing Elmt_Decl first was to catch the error of modifying it,
	which is illegal because it's a loop parameter. The above causes us to
	miss that error.  Therefore, we add a flag Is_Loop_Parameter, and set
	it on the Element entity, so we end up with an E_Variable node with the
	flag set.
	* einfo.ads, einfo.adb (Is_Loop_Parameter): New flag.
	* sem_ch5.adb (Diagnose_Non_Variable_Lhs): Give the "assignment to loop
	parameter not allowed" error if Is_Loop_Parameter.
	* sem_util.adb (Is_Variable): Return False if Is_Loop_Parameter, to
	trigger the call to Diagnose_Non_Variable_Lhs.

From-SVN: r260930

2018-05-30  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* checks.adb (Apply_Scalar_Range_Check):
	* sem_eval.adb (Check_Non_Static_Context, Out_Of_Range): Ignore out of
	range values for System.Priority in CodePeer mode since the actual
	target compiler may provide a wider range.

From-SVN: r260929

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb: Search specification of main unit as well, for
	unnesting.

From-SVN: r260928

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch7.adb (Check_Unnesting_Elaboration_Code): The statement part of
	a package body that is a compilation unit may contain blocks that
	declare local subprograms.  In Subprogram_Unnesting Mode such
	subprograms must be handled as nested inside the (implicit) elaboration
	procedure that executes that statement part. To handle properly uplevel
	references we construct that subprogram explicitly, to contain blocks
	and inner subprograms, The statement part of the compilation unit
	becomes a call to this subprogram. This is only done if blocks are
	present in the statement list of the body.

From-SVN: r260927

2018-05-30  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch7.adb: Minor comment fix.

From-SVN: r260926

2018-05-30  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node): Handle properly subprogram instantiations
	that have no corresponding body and appear as attributes of the
	corresponding wrapper package declaration.
	(Register_Subprogram): New subprogram, used for subprogram bodies and
	for subprogram instantiations to enter callable entity into Subp table.

From-SVN: r260925

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

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

gcc/ada/

	* exp_aggr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb, exp_unst.adb,
	exp_util.adb, exp_util.ads, libgnat/a-calcon.adb, libgnat/a-calcon.ads,
	libgnat/s-os_lib.adb, repinfo.adb, sem_ch3.adb, sem_disp.adb,
	sem_disp.ads, sem_util.adb: Minor reformatting.

From-SVN: r260923

2018-05-30  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* gcc-interface/Makefile.in: Move special flags for Ada runtime files
	from here...
	* Makefile.rtl: ... to here.  Update comments.  Protect call to
	"GCC_FOR_TARGET" in case target_os isn't defined.

From-SVN: r260922

2018-05-30  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* gcc-interface/Makefile.in: Move target pair settings from here...
	* Makefile.rtl: ... to here.
	(setup-rts): New target.

From-SVN: r260921

	* typeck.c (cxx_sizeof_or_alignof_type): Return size_one_node instead
	of using it in dead store.

From-SVN: r260920

This patch generalises various places that used hwi tree accessors so
that they can handle poly_ints instead.  In many cases these changes
are by inspection rather than because something had shown them to be
necessary.

I think the alias.c part is a minor bug fix: previously we used
fits_uhwi_p for a signed HOST_WIDE_INT (which the caller does
treat as signed rather than unsigned).  We also checked whether
each individual offset overflowed but didn't check whether the
sum did.

2018-05-30  Richard Sandiford  <richard.sandiford@linaro.org>

gcc/
	* alias.c (adjust_offset_for_component_ref): Use poly_int_tree_p
	and wi::to_poly_offset.  Add the current offset and then check
	whether the sum fits, rather than using an unchecked addition of
	a checked term.  Check for a shwi rather than a uhwi.
	* expr.c (get_bit_range): Use tree_to_poly_uint64.
	(store_constructor): Use poly_int_tree_p.
	(expand_expr_real_1): Likewise.
	* function.c (assign_temp): Likewise.
	* fold-const.c (const_binop): Use poly_int_tree_p and
	wi::to_poly_offset.
	(fold_indirect_ref_1): Likewise.  Use multiple_p to attempt an exact
	division.
	* ipa-icf-gimple.c (func_checker::compare_operand): Use
	to_poly_offset for MEM offsets.
	* ipa-icf.c (sem_variable::equals): Likewise.
	* stor-layout.c (compute_record_mode): Use poly_int_tree_p.
	* tree-ssa-sccvn.c (ao_ref_init_from_vn_reference): Use
	wi::to_poly_offset for BIT_FIELD_REF offsets.
	(vn_reference_maybe_forwprop_address): Use poly_int_tree_p and
	wi::to_poly_offset.
	* var-tracking.c (emit_note_insn_var_location): Use
	tree_to_poly_uint64.

From-SVN: r260914

    
    Backport https://golang.org/cl/113715 and https://golang.org/cl/113716:
    
    cmd/go: don't pass -compiler flag to vet
    
    Without this running go vet -compiler=gccgo causes vet to fail.
    The vet tool does need to know the compiler, but it is passed in
    vetConfig.Compiler.
    
    cmd/go, cmd/vet, go/internal/gccgoimport: make vet work with gccgo
    
    When using gccgo/GoLLVM, there is no package file for a standard
    library package. Since it is impossible for the go tool to rebuild the
    package, and since the package file exists only in the form of a .gox
    file, this seems like the best choice. Unfortunately it was confusing
    vet, which wanted to see a real file. This caused vet to report errors
    about missing package files for standard library packages. The
    gccgoimporter knows how to correctly handle this case. Fix this by
    
    1) telling vet which packages are standard;
    2) letting vet skip those packages;
    3) letting the gccgoimporter handle this case.
    
    As a separate required fix, gccgo/GoLLVM has no runtime/cgo package,
    so don't try to depend on it (as it happens, this fixes golang/go#25324).
    
    The result is that the cmd/go vet tests pass when using -compiler=gccgo.
    
    Reviewed-on: https://go-review.googlesource.com/114516

From-SVN: r260913

From-SVN: r260912

    
    Reviewed-on: https://go-review.googlesource.com/113179

From-SVN: r260908

	* config/riscv/riscv.c (riscv_interrupt_type): Fix comment typo.

From-SVN: r260907

	PR c++/67711 - assigning from temporary initializer_list.
	PR c++/48562 - new initializer_list.
	* typeck.c (maybe_warn_about_returning_address_of_local): Also warn
	about returning local initializer_list.
	* cp-tree.h (AUTO_TEMP_NAME, TEMP_NAME_P): Remove.
	* call.c (build_over_call): Warn about assignment from temporary
	init_list.
	* init.c (build_new_1): Warn about 'new std::initializer_list'.
	(find_list_begin, maybe_warn_list_ctor): New.
	(perform_member_init): Use maybe_warn_list_ctor.

From-SVN: r260905

	PR target/85950
	* config/i386/i386.md (l<rounding_insn><MODEF:mode><SWI48:mode>2):
	Enable for TARGET_SSE4_1 and generate rounds{s,d} and cvtts{s,d}2si{,q}
	sequence.
	(sse4_1_round<mode>2): Use nonimmediate_operand
	for operand 1 predicate.

testsuite/ChangeLog:

	PR target/85950
	* gcc.target/i386/pr85950.c: New test.

From-SVN: r260903

PR middle-end/85888 - New test case c-c++-common/attr-nonstring-6.c from r260541 fails with excess errors

2018-05-29  Martin Sebor  <msebor@redhat.com>
	    Richard Biener  <rguenther@suse.de>

	PR testsuite/85888
	* calls.c (get_size_range): Call determine_value_range instead
	of get_value_range..
	* tree-vrp.h (determine_value_range): Declared new function.
	* tree-vrp.c (determine_value_range_1, determine_value_range): New.

Co-Authored-By: Richard Biener <rguenther@suse.de>

From-SVN: r260902

	PR c++/85883
	* init.c (build_new): Handle deducing a class with new
	with more than one argument.

	* g++.dg/cpp1z/class-deduction55.C: New test.
	* g++.dg/cpp1z/class-deduction56.C: New test.
	* g++.dg/cpp1z/class-deduction57.C: New test.

From-SVN: r260901