view gcc/ada/sem_prag.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
line wrap: on
line source

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S E M _ P R A G                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  This unit contains the semantic processing for all pragmas, both language
--  and implementation defined. For most pragmas, the parser only does the
--  most basic job of checking the syntax, so Sem_Prag also contains the code
--  to complete the syntax checks. Certain pragmas are handled partially or
--  completely by the parser (see Par.Prag for further details).

with Aspects;   use Aspects;
with Atree;     use Atree;
with Casing;    use Casing;
with Checks;    use Checks;
with Contracts; use Contracts;
with Csets;     use Csets;
with Debug;     use Debug;
with Einfo;     use Einfo;
with Elists;    use Elists;
with Errout;    use Errout;
with Exp_Dist;  use Exp_Dist;
with Exp_Util;  use Exp_Util;
with Freeze;    use Freeze;
with Ghost;     use Ghost;
with Gnatvsn;   use Gnatvsn;
with Lib;       use Lib;
with Lib.Writ;  use Lib.Writ;
with Lib.Xref;  use Lib.Xref;
with Namet.Sp;  use Namet.Sp;
with Nlists;    use Nlists;
with Nmake;     use Nmake;
with Output;    use Output;
with Par_SCO;   use Par_SCO;
with Restrict;  use Restrict;
with Rident;    use Rident;
with Rtsfind;   use Rtsfind;
with Sem;       use Sem;
with Sem_Aux;   use Sem_Aux;
with Sem_Ch3;   use Sem_Ch3;
with Sem_Ch6;   use Sem_Ch6;
with Sem_Ch8;   use Sem_Ch8;
with Sem_Ch12;  use Sem_Ch12;
with Sem_Ch13;  use Sem_Ch13;
with Sem_Disp;  use Sem_Disp;
with Sem_Dist;  use Sem_Dist;
with Sem_Elab;  use Sem_Elab;
with Sem_Elim;  use Sem_Elim;
with Sem_Eval;  use Sem_Eval;
with Sem_Intr;  use Sem_Intr;
with Sem_Mech;  use Sem_Mech;
with Sem_Res;   use Sem_Res;
with Sem_Type;  use Sem_Type;
with Sem_Util;  use Sem_Util;
with Sem_Warn;  use Sem_Warn;
with Stand;     use Stand;
with Sinfo;     use Sinfo;
with Sinfo.CN;  use Sinfo.CN;
with Sinput;    use Sinput;
with Stringt;   use Stringt;
with Stylesw;   use Stylesw;
with Table;
with Targparm;  use Targparm;
with Tbuild;    use Tbuild;
with Ttypes;
with Uintp;     use Uintp;
with Uname;     use Uname;
with Urealp;    use Urealp;
with Validsw;   use Validsw;
with Warnsw;    use Warnsw;

with System.Case_Util;

package body Sem_Prag is

   ----------------------------------------------
   -- Common Handling of Import-Export Pragmas --
   ----------------------------------------------

   --  In the following section, a number of Import_xxx and Export_xxx pragmas
   --  are defined by GNAT. These are compatible with the DEC pragmas of the
   --  same name, and all have the following common form and processing:

   --  pragma Export_xxx
   --        [Internal                 =>] LOCAL_NAME
   --     [, [External                 =>] EXTERNAL_SYMBOL]
   --     [, other optional parameters   ]);

   --  pragma Import_xxx
   --        [Internal                 =>] LOCAL_NAME
   --     [, [External                 =>] EXTERNAL_SYMBOL]
   --     [, other optional parameters   ]);

   --   EXTERNAL_SYMBOL ::=
   --     IDENTIFIER
   --   | static_string_EXPRESSION

   --  The internal LOCAL_NAME designates the entity that is imported or
   --  exported, and must refer to an entity in the current declarative
   --  part (as required by the rules for LOCAL_NAME).

   --  The external linker name is designated by the External parameter if
   --  given, or the Internal parameter if not (if there is no External
   --  parameter, the External parameter is a copy of the Internal name).

   --  If the External parameter is given as a string, then this string is
   --  treated as an external name (exactly as though it had been given as an
   --  External_Name parameter for a normal Import pragma).

   --  If the External parameter is given as an identifier (or there is no
   --  External parameter, so that the Internal identifier is used), then
   --  the external name is the characters of the identifier, translated
   --  to all lower case letters.

   --  Note: the external name specified or implied by any of these special
   --  Import_xxx or Export_xxx pragmas override an external or link name
   --  specified in a previous Import or Export pragma.

   --  Note: these and all other DEC-compatible GNAT pragmas allow full use of
   --  named notation, following the standard rules for subprogram calls, i.e.
   --  parameters can be given in any order if named notation is used, and
   --  positional and named notation can be mixed, subject to the rule that all
   --  positional parameters must appear first.

   --  Note: All these pragmas are implemented exactly following the DEC design
   --  and implementation and are intended to be fully compatible with the use
   --  of these pragmas in the DEC Ada compiler.

   --------------------------------------------
   -- Checking for Duplicated External Names --
   --------------------------------------------

   --  It is suspicious if two separate Export pragmas use the same external
   --  name. The following table is used to diagnose this situation so that
   --  an appropriate warning can be issued.

   --  The Node_Id stored is for the N_String_Literal node created to hold
   --  the value of the external name. The Sloc of this node is used to
   --  cross-reference the location of the duplication.

   package Externals is new Table.Table (
     Table_Component_Type => Node_Id,
     Table_Index_Type     => Int,
     Table_Low_Bound      => 0,
     Table_Initial        => 100,
     Table_Increment      => 100,
     Table_Name           => "Name_Externals");

   -------------------------------------
   -- Local Subprograms and Variables --
   -------------------------------------

   function Adjust_External_Name_Case (N : Node_Id) return Node_Id;
   --  This routine is used for possible casing adjustment of an explicit
   --  external name supplied as a string literal (the node N), according to
   --  the casing requirement of Opt.External_Name_Casing. If this is set to
   --  As_Is, then the string literal is returned unchanged, but if it is set
   --  to Uppercase or Lowercase, then a new string literal with appropriate
   --  casing is constructed.

   procedure Analyze_Part_Of
     (Indic    : Node_Id;
      Item_Id  : Entity_Id;
      Encap    : Node_Id;
      Encap_Id : out Entity_Id;
      Legal    : out Boolean);
   --  Subsidiary to Analyze_Part_Of_In_Decl_Part, Analyze_Part_Of_Option and
   --  Analyze_Pragma. Perform full analysis of indicator Part_Of. Indic is the
   --  Part_Of indicator. Item_Id is the entity of an abstract state, object or
   --  package instantiation. Encap denotes the encapsulating state or single
   --  concurrent type. Encap_Id is the entity of Encap. Flag Legal is set when
   --  the indicator is legal.

   function Appears_In (List : Elist_Id; Item_Id : Entity_Id) return Boolean;
   --  Subsidiary to analysis of pragmas Depends, Global and Refined_Depends.
   --  Query whether a particular item appears in a mixed list of nodes and
   --  entities. It is assumed that all nodes in the list have entities.

   procedure Check_Postcondition_Use_In_Inlined_Subprogram
     (Prag    : Node_Id;
      Spec_Id : Entity_Id);
   --  Subsidiary to the analysis of pragmas Contract_Cases, Postcondition,
   --  Precondition, Refined_Post, and Test_Case. Emit a warning when pragma
   --  Prag is associated with subprogram Spec_Id subject to Inline_Always,
   --  and assertions are enabled.

   procedure Check_State_And_Constituent_Use
     (States   : Elist_Id;
      Constits : Elist_Id;
      Context  : Node_Id);
   --  Subsidiary to the analysis of pragmas [Refined_]Depends, [Refined_]
   --  Global and Initializes. Determine whether a state from list States and a
   --  corresponding constituent from list Constits (if any) appear in the same
   --  context denoted by Context. If this is the case, emit an error.

   procedure Contract_Freeze_Error
     (Contract_Id : Entity_Id;
      Freeze_Id   : Entity_Id);
   --  Subsidiary to the analysis of pragmas Contract_Cases, Part_Of, Post, and
   --  Pre. Emit a freezing-related error message where Freeze_Id is the entity
   --  of a body which caused contract freezing and Contract_Id denotes the
   --  entity of the affected contstruct.

   procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id);
   --  Subsidiary to all Find_Related_xxx routines. Emit an error on pragma
   --  Prag that duplicates previous pragma Prev.

   function Find_Encapsulating_State
     (States     : Elist_Id;
      Constit_Id : Entity_Id) return Entity_Id;
   --  Given the entity of a constituent Constit_Id, find the corresponding
   --  encapsulating state which appears in States. The routine returns Empty
   --  if no such state is found.

   function Find_Related_Context
     (Prag      : Node_Id;
      Do_Checks : Boolean := False) return Node_Id;
   --  Subsidiary to the analysis of pragmas
   --    Async_Readers
   --    Async_Writers
   --    Constant_After_Elaboration
   --    Effective_Reads
   --    Effective_Writers
   --    Part_Of
   --  Find the first source declaration or statement found while traversing
   --  the previous node chain starting from pragma Prag. If flag Do_Checks is
   --  set, the routine reports duplicate pragmas. The routine returns Empty
   --  when reaching the start of the node chain.

   function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;
   --  If Def_Id refers to a renamed subprogram, then the base subprogram (the
   --  original one, following the renaming chain) is returned. Otherwise the
   --  entity is returned unchanged. Should be in Einfo???

   function Get_SPARK_Mode_Type (N : Name_Id) return SPARK_Mode_Type;
   --  Subsidiary to the analysis of pragma SPARK_Mode as well as subprogram
   --  Get_SPARK_Mode_From_Annotation. Convert a name into a corresponding
   --  value of type SPARK_Mode_Type.

   function Has_Extra_Parentheses (Clause : Node_Id) return Boolean;
   --  Subsidiary to the analysis of pragmas Depends and Refined_Depends.
   --  Determine whether dependency clause Clause is surrounded by extra
   --  parentheses. If this is the case, issue an error message.

   function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean;
   --  Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of
   --  pragma Depends. Determine whether the type of dependency item Item is
   --  tagged, unconstrained array, unconstrained record or a record with at
   --  least one unconstrained component.

   procedure Record_Possible_Body_Reference
     (State_Id : Entity_Id;
      Ref      : Node_Id);
   --  Subsidiary to the analysis of pragmas [Refined_]Depends and [Refined_]
   --  Global. Given an abstract state denoted by State_Id and a reference Ref
   --  to it, determine whether the reference appears in a package body that
   --  will eventually refine the state. If this is the case, record the
   --  reference for future checks (see Analyze_Refined_State_In_Decls).

   procedure Resolve_State (N : Node_Id);
   --  Handle the overloading of state names by functions. When N denotes a
   --  function, this routine finds the corresponding state and sets the entity
   --  of N to that of the state.

   procedure Rewrite_Assertion_Kind
     (N           : Node_Id;
      From_Policy : Boolean := False);
   --  If N is Pre'Class, Post'Class, Invariant'Class, or Type_Invariant'Class,
   --  then it is rewritten as an identifier with the corresponding special
   --  name _Pre, _Post, _Invariant, or _Type_Invariant. Used by pragmas Check
   --  and Check_Policy. If the names are Precondition or Postcondition, this
   --  combination is deprecated in favor of Assertion_Policy and Ada2012
   --  Aspect names. The parameter From_Policy indicates that the pragma
   --  is the old non-standard Check_Policy and not a rewritten pragma.

   procedure Set_Elab_Unit_Name (N : Node_Id; With_Item : Node_Id);
   --  Place semantic information on the argument of an Elaborate/Elaborate_All
   --  pragma. Entity name for unit and its parents is taken from item in
   --  previous with_clause that mentions the unit.

   Dummy : Integer := 0;
   pragma Volatile (Dummy);
   --  Dummy volatile integer used in bodies of ip/rv to prevent optimization

   procedure ip;
   pragma No_Inline (ip);
   --  A dummy procedure called when pragma Inspection_Point is analyzed. This
   --  is just to help debugging the front end. If a pragma Inspection_Point
   --  is added to a source program, then breaking on ip will get you to that
   --  point in the program.

   procedure rv;
   pragma No_Inline (rv);
   --  This is a dummy function called by the processing for pragma Reviewable.
   --  It is there for assisting front end debugging. By placing a Reviewable
   --  pragma in the source program, a breakpoint on rv catches this place in
   --  the source, allowing convenient stepping to the point of interest.

   -------------------------------
   -- Adjust_External_Name_Case --
   -------------------------------

   function Adjust_External_Name_Case (N : Node_Id) return Node_Id is
      CC : Char_Code;

   begin
      --  Adjust case of literal if required

      if Opt.External_Name_Exp_Casing = As_Is then
         return N;

      else
         --  Copy existing string

         Start_String;

         --  Set proper casing

         for J in 1 .. String_Length (Strval (N)) loop
            CC := Get_String_Char (Strval (N), J);

            if Opt.External_Name_Exp_Casing = Uppercase
              and then CC >= Get_Char_Code ('a')
              and then CC <= Get_Char_Code ('z')
            then
               Store_String_Char (CC - 32);

            elsif Opt.External_Name_Exp_Casing = Lowercase
              and then CC >= Get_Char_Code ('A')
              and then CC <= Get_Char_Code ('Z')
            then
               Store_String_Char (CC + 32);

            else
               Store_String_Char (CC);
            end if;
         end loop;

         return
           Make_String_Literal (Sloc (N),
             Strval => End_String);
      end if;
   end Adjust_External_Name_Case;

   -----------------------------------------
   -- Analyze_Contract_Cases_In_Decl_Part --
   -----------------------------------------

   --  WARNING: This routine manages Ghost regions. Return statements must be
   --  replaced by gotos which jump to the end of the routine and restore the
   --  Ghost mode.

   procedure Analyze_Contract_Cases_In_Decl_Part
     (N         : Node_Id;
      Freeze_Id : Entity_Id := Empty)
   is
      Subp_Decl : constant Node_Id   := Find_Related_Declaration_Or_Body (N);
      Spec_Id   : constant Entity_Id := Unique_Defining_Entity (Subp_Decl);

      Others_Seen : Boolean := False;
      --  This flag is set when an "others" choice is encountered. It is used
      --  to detect multiple illegal occurrences of "others".

      procedure Analyze_Contract_Case (CCase : Node_Id);
      --  Verify the legality of a single contract case

      ---------------------------
      -- Analyze_Contract_Case --
      ---------------------------

      procedure Analyze_Contract_Case (CCase : Node_Id) is
         Case_Guard  : Node_Id;
         Conseq      : Node_Id;
         Errors      : Nat;
         Extra_Guard : Node_Id;

      begin
         if Nkind (CCase) = N_Component_Association then
            Case_Guard := First (Choices (CCase));
            Conseq     := Expression (CCase);

            --  Each contract case must have exactly one case guard

            Extra_Guard := Next (Case_Guard);

            if Present (Extra_Guard) then
               Error_Msg_N
                 ("contract case must have exactly one case guard",
                  Extra_Guard);
            end if;

            --  Check placement of OTHERS if available (SPARK RM 6.1.3(1))

            if Nkind (Case_Guard) = N_Others_Choice then
               if Others_Seen then
                  Error_Msg_N
                    ("only one others choice allowed in contract cases",
                     Case_Guard);
               else
                  Others_Seen := True;
               end if;

            elsif Others_Seen then
               Error_Msg_N
                 ("others must be the last choice in contract cases", N);
            end if;

            --  Preanalyze the case guard and consequence

            if Nkind (Case_Guard) /= N_Others_Choice then
               Errors := Serious_Errors_Detected;
               Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);

               --  Emit a clarification message when the case guard contains
               --  at least one undefined reference, possibly due to contract
               --  freezing.

               if Errors /= Serious_Errors_Detected
                 and then Present (Freeze_Id)
                 and then Has_Undefined_Reference (Case_Guard)
               then
                  Contract_Freeze_Error (Spec_Id, Freeze_Id);
               end if;
            end if;

            Errors := Serious_Errors_Detected;
            Preanalyze_Assert_Expression (Conseq, Standard_Boolean);

            --  Emit a clarification message when the consequence contains
            --  at least one undefined reference, possibly due to contract
            --  freezing.

            if Errors /= Serious_Errors_Detected
              and then Present (Freeze_Id)
              and then Has_Undefined_Reference (Conseq)
            then
               Contract_Freeze_Error (Spec_Id, Freeze_Id);
            end if;

         --  The contract case is malformed

         else
            Error_Msg_N ("wrong syntax in contract case", CCase);
         end if;
      end Analyze_Contract_Case;

      --  Local variables

      CCases : constant Node_Id := Expression (Get_Argument (N, Spec_Id));

      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
      --  Save the Ghost-related attributes to restore on exit

      CCase         : Node_Id;
      Restore_Scope : Boolean := False;

   --  Start of processing for Analyze_Contract_Cases_In_Decl_Part

   begin
      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      --  Set the Ghost mode in effect from the pragma. Due to the delayed
      --  analysis of the pragma, the Ghost mode at point of declaration and
      --  point of analysis may not necessarily be the same. Use the mode in
      --  effect at the point of declaration.

      Set_Ghost_Mode (N);

      --  Single and multiple contract cases must appear in aggregate form. If
      --  this is not the case, then either the parser of the analysis of the
      --  pragma failed to produce an aggregate.

      pragma Assert (Nkind (CCases) = N_Aggregate);

      if Present (Component_Associations (CCases)) then

         --  Ensure that the formal parameters are visible when analyzing all
         --  clauses. This falls out of the general rule of aspects pertaining
         --  to subprogram declarations.

         if not In_Open_Scopes (Spec_Id) then
            Restore_Scope := True;
            Push_Scope (Spec_Id);

            if Is_Generic_Subprogram (Spec_Id) then
               Install_Generic_Formals (Spec_Id);
            else
               Install_Formals (Spec_Id);
            end if;
         end if;

         CCase := First (Component_Associations (CCases));
         while Present (CCase) loop
            Analyze_Contract_Case (CCase);
            Next (CCase);
         end loop;

         if Restore_Scope then
            End_Scope;
         end if;

         --  Currently it is not possible to inline pre/postconditions on a
         --  subprogram subject to pragma Inline_Always.

         Check_Postcondition_Use_In_Inlined_Subprogram (N, Spec_Id);

      --  Otherwise the pragma is illegal

      else
         Error_Msg_N ("wrong syntax for constract cases", N);
      end if;

      Set_Is_Analyzed_Pragma (N);

      Restore_Ghost_Region (Saved_GM, Saved_IGR);
   end Analyze_Contract_Cases_In_Decl_Part;

   ----------------------------------
   -- Analyze_Depends_In_Decl_Part --
   ----------------------------------

   procedure Analyze_Depends_In_Decl_Part (N : Node_Id) is
      Loc       : constant Source_Ptr := Sloc (N);
      Subp_Decl : constant Node_Id    := Find_Related_Declaration_Or_Body (N);
      Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Subp_Decl);

      All_Inputs_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all the inputs processed so far.
      --  The list is populated with unique entities because the same input
      --  may appear in multiple input lists.

      All_Outputs_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all the outputs processed so far.
      --  The list is populated with unique entities because output items are
      --  unique in a dependence relation.

      Constits_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all constituents processed so far.
      --  It aids in detecting illegal usage of a state and a corresponding
      --  constituent in pragma [Refinde_]Depends.

      Global_Seen : Boolean := False;
      --  A flag set when pragma Global has been processed

      Null_Output_Seen : Boolean := False;
      --  A flag used to track the legality of a null output

      Result_Seen : Boolean := False;
      --  A flag set when Spec_Id'Result is processed

      States_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all states processed so far. It
      --  helps in detecting illegal usage of a state and a corresponding
      --  constituent in pragma [Refined_]Depends.

      Subp_Inputs  : Elist_Id := No_Elist;
      Subp_Outputs : Elist_Id := No_Elist;
      --  Two lists containing the full set of inputs and output of the related
      --  subprograms. Note that these lists contain both nodes and entities.

      Task_Input_Seen  : Boolean := False;
      Task_Output_Seen : Boolean := False;
      --  Flags used to track the implicit dependence of a task unit on itself

      procedure Add_Item_To_Name_Buffer (Item_Id : Entity_Id);
      --  Subsidiary routine to Check_Role and Check_Usage. Add the item kind
      --  to the name buffer. The individual kinds are as follows:
      --    E_Abstract_State           - "state"
      --    E_Constant                 - "constant"
      --    E_Generic_In_Out_Parameter - "generic parameter"
      --    E_Generic_In_Parameter     - "generic parameter"
      --    E_In_Parameter             - "parameter"
      --    E_In_Out_Parameter         - "parameter"
      --    E_Loop_Parameter           - "loop parameter"
      --    E_Out_Parameter            - "parameter"
      --    E_Protected_Type           - "current instance of protected type"
      --    E_Task_Type                - "current instance of task type"
      --    E_Variable                 - "global"

      procedure Analyze_Dependency_Clause
        (Clause  : Node_Id;
         Is_Last : Boolean);
      --  Verify the legality of a single dependency clause. Flag Is_Last
      --  denotes whether Clause is the last clause in the relation.

      procedure Check_Function_Return;
      --  Verify that Funtion'Result appears as one of the outputs
      --  (SPARK RM 6.1.5(10)).

      procedure Check_Role
        (Item     : Node_Id;
         Item_Id  : Entity_Id;
         Is_Input : Boolean;
         Self_Ref : Boolean);
      --  Ensure that an item fulfills its designated input and/or output role
      --  as specified by pragma Global (if any) or the enclosing context. If
      --  this is not the case, emit an error. Item and Item_Id denote the
      --  attributes of an item. Flag Is_Input should be set when item comes
      --  from an input list. Flag Self_Ref should be set when the item is an
      --  output and the dependency clause has operator "+".

      procedure Check_Usage
        (Subp_Items : Elist_Id;
         Used_Items : Elist_Id;
         Is_Input   : Boolean);
      --  Verify that all items from Subp_Items appear in Used_Items. Emit an
      --  error if this is not the case.

      procedure Normalize_Clause (Clause : Node_Id);
      --  Remove a self-dependency "+" from the input list of a clause

      -----------------------------
      -- Add_Item_To_Name_Buffer --
      -----------------------------

      procedure Add_Item_To_Name_Buffer (Item_Id : Entity_Id) is
      begin
         if Ekind (Item_Id) = E_Abstract_State then
            Add_Str_To_Name_Buffer ("state");

         elsif Ekind (Item_Id) = E_Constant then
            Add_Str_To_Name_Buffer ("constant");

         elsif Ekind_In (Item_Id, E_Generic_In_Out_Parameter,
                                  E_Generic_In_Parameter)
         then
            Add_Str_To_Name_Buffer ("generic parameter");

         elsif Is_Formal (Item_Id) then
            Add_Str_To_Name_Buffer ("parameter");

         elsif Ekind (Item_Id) = E_Loop_Parameter then
            Add_Str_To_Name_Buffer ("loop parameter");

         elsif Ekind (Item_Id) = E_Protected_Type
           or else Is_Single_Protected_Object (Item_Id)
         then
            Add_Str_To_Name_Buffer ("current instance of protected type");

         elsif Ekind (Item_Id) = E_Task_Type
           or else Is_Single_Task_Object (Item_Id)
         then
            Add_Str_To_Name_Buffer ("current instance of task type");

         elsif Ekind (Item_Id) = E_Variable then
            Add_Str_To_Name_Buffer ("global");

         --  The routine should not be called with non-SPARK items

         else
            raise Program_Error;
         end if;
      end Add_Item_To_Name_Buffer;

      -------------------------------
      -- Analyze_Dependency_Clause --
      -------------------------------

      procedure Analyze_Dependency_Clause
        (Clause  : Node_Id;
         Is_Last : Boolean)
      is
         procedure Analyze_Input_List (Inputs : Node_Id);
         --  Verify the legality of a single input list

         procedure Analyze_Input_Output
           (Item          : Node_Id;
            Is_Input      : Boolean;
            Self_Ref      : Boolean;
            Top_Level     : Boolean;
            Seen          : in out Elist_Id;
            Null_Seen     : in out Boolean;
            Non_Null_Seen : in out Boolean);
         --  Verify the legality of a single input or output item. Flag
         --  Is_Input should be set whenever Item is an input, False when it
         --  denotes an output. Flag Self_Ref should be set when the item is an
         --  output and the dependency clause has a "+". Flag Top_Level should
         --  be set whenever Item appears immediately within an input or output
         --  list. Seen is a collection of all abstract states, objects and
         --  formals processed so far. Flag Null_Seen denotes whether a null
         --  input or output has been encountered. Flag Non_Null_Seen denotes
         --  whether a non-null input or output has been encountered.

         ------------------------
         -- Analyze_Input_List --
         ------------------------

         procedure Analyze_Input_List (Inputs : Node_Id) is
            Inputs_Seen : Elist_Id := No_Elist;
            --  A list containing the entities of all inputs that appear in the
            --  current input list.

            Non_Null_Input_Seen : Boolean := False;
            Null_Input_Seen     : Boolean := False;
            --  Flags used to check the legality of an input list

            Input : Node_Id;

         begin
            --  Multiple inputs appear as an aggregate

            if Nkind (Inputs) = N_Aggregate then
               if Present (Component_Associations (Inputs)) then
                  SPARK_Msg_N
                    ("nested dependency relations not allowed", Inputs);

               elsif Present (Expressions (Inputs)) then
                  Input := First (Expressions (Inputs));
                  while Present (Input) loop
                     Analyze_Input_Output
                       (Item          => Input,
                        Is_Input      => True,
                        Self_Ref      => False,
                        Top_Level     => False,
                        Seen          => Inputs_Seen,
                        Null_Seen     => Null_Input_Seen,
                        Non_Null_Seen => Non_Null_Input_Seen);

                     Next (Input);
                  end loop;

               --  Syntax error, always report

               else
                  Error_Msg_N ("malformed input dependency list", Inputs);
               end if;

            --  Process a solitary input

            else
               Analyze_Input_Output
                 (Item          => Inputs,
                  Is_Input      => True,
                  Self_Ref      => False,
                  Top_Level     => False,
                  Seen          => Inputs_Seen,
                  Null_Seen     => Null_Input_Seen,
                  Non_Null_Seen => Non_Null_Input_Seen);
            end if;

            --  Detect an illegal dependency clause of the form

            --    (null =>[+] null)

            if Null_Output_Seen and then Null_Input_Seen then
               SPARK_Msg_N
                 ("null dependency clause cannot have a null input list",
                  Inputs);
            end if;
         end Analyze_Input_List;

         --------------------------
         -- Analyze_Input_Output --
         --------------------------

         procedure Analyze_Input_Output
           (Item          : Node_Id;
            Is_Input      : Boolean;
            Self_Ref      : Boolean;
            Top_Level     : Boolean;
            Seen          : in out Elist_Id;
            Null_Seen     : in out Boolean;
            Non_Null_Seen : in out Boolean)
         is
            procedure Current_Task_Instance_Seen;
            --  Set the appropriate global flag when the current instance of a
            --  task unit is encountered.

            --------------------------------
            -- Current_Task_Instance_Seen --
            --------------------------------

            procedure Current_Task_Instance_Seen is
            begin
               if Is_Input then
                  Task_Input_Seen := True;
               else
                  Task_Output_Seen := True;
               end if;
            end Current_Task_Instance_Seen;

            --  Local variables

            Is_Output : constant Boolean := not Is_Input;
            Grouped   : Node_Id;
            Item_Id   : Entity_Id;

         --  Start of processing for Analyze_Input_Output

         begin
            --  Multiple input or output items appear as an aggregate

            if Nkind (Item) = N_Aggregate then
               if not Top_Level then
                  SPARK_Msg_N ("nested grouping of items not allowed", Item);

               elsif Present (Component_Associations (Item)) then
                  SPARK_Msg_N
                    ("nested dependency relations not allowed", Item);

               --  Recursively analyze the grouped items

               elsif Present (Expressions (Item)) then
                  Grouped := First (Expressions (Item));
                  while Present (Grouped) loop
                     Analyze_Input_Output
                       (Item          => Grouped,
                        Is_Input      => Is_Input,
                        Self_Ref      => Self_Ref,
                        Top_Level     => False,
                        Seen          => Seen,
                        Null_Seen     => Null_Seen,
                        Non_Null_Seen => Non_Null_Seen);

                     Next (Grouped);
                  end loop;

               --  Syntax error, always report

               else
                  Error_Msg_N ("malformed dependency list", Item);
               end if;

            --  Process attribute 'Result in the context of a dependency clause

            elsif Is_Attribute_Result (Item) then
               Non_Null_Seen := True;

               Analyze (Item);

               --  Attribute 'Result is allowed to appear on the output side of
               --  a dependency clause (SPARK RM 6.1.5(6)).

               if Is_Input then
                  SPARK_Msg_N ("function result cannot act as input", Item);

               elsif Null_Seen then
                  SPARK_Msg_N
                    ("cannot mix null and non-null dependency items", Item);

               else
                  Result_Seen := True;
               end if;

            --  Detect multiple uses of null in a single dependency list or
            --  throughout the whole relation. Verify the placement of a null
            --  output list relative to the other clauses (SPARK RM 6.1.5(12)).

            elsif Nkind (Item) = N_Null then
               if Null_Seen then
                  SPARK_Msg_N
                    ("multiple null dependency relations not allowed", Item);

               elsif Non_Null_Seen then
                  SPARK_Msg_N
                    ("cannot mix null and non-null dependency items", Item);

               else
                  Null_Seen := True;

                  if Is_Output then
                     if not Is_Last then
                        SPARK_Msg_N
                          ("null output list must be the last clause in a "
                           & "dependency relation", Item);

                     --  Catch a useless dependence of the form:
                     --    null =>+ ...

                     elsif Self_Ref then
                        SPARK_Msg_N
                          ("useless dependence, null depends on itself", Item);
                     end if;
                  end if;
               end if;

            --  Default case

            else
               Non_Null_Seen := True;

               if Null_Seen then
                  SPARK_Msg_N ("cannot mix null and non-null items", Item);
               end if;

               Analyze       (Item);
               Resolve_State (Item);

               --  Find the entity of the item. If this is a renaming, climb
               --  the renaming chain to reach the root object. Renamings of
               --  non-entire objects do not yield an entity (Empty).

               Item_Id := Entity_Of (Item);

               if Present (Item_Id) then

                  --  Constants

                  if Ekind_In (Item_Id, E_Constant, E_Loop_Parameter)
                      or else

                    --  Current instances of concurrent types

                    Ekind_In (Item_Id, E_Protected_Type, E_Task_Type)
                      or else

                    --  Formal parameters

                    Ekind_In (Item_Id, E_Generic_In_Out_Parameter,
                                       E_Generic_In_Parameter,
                                       E_In_Parameter,
                                       E_In_Out_Parameter,
                                       E_Out_Parameter)
                      or else

                    --  States, variables

                    Ekind_In (Item_Id, E_Abstract_State, E_Variable)
                  then
                     --  A [generic] function is not allowed to have Output
                     --  items in its dependency relations. Note that "null"
                     --  and attribute 'Result are still valid items.

                     if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
                       and then not Is_Input
                     then
                        SPARK_Msg_N
                          ("output item is not applicable to function", Item);
                     end if;

                     --  The item denotes a concurrent type. Note that single
                     --  protected/task types are not considered here because
                     --  they behave as objects in the context of pragma
                     --  [Refined_]Depends.

                     if Ekind_In (Item_Id, E_Protected_Type, E_Task_Type) then

                        --  This use is legal as long as the concurrent type is
                        --  the current instance of an enclosing type.

                        if Is_CCT_Instance (Item_Id, Spec_Id) then

                           --  The dependence of a task unit on itself is
                           --  implicit and may or may not be explicitly
                           --  specified (SPARK RM 6.1.4).

                           if Ekind (Item_Id) = E_Task_Type then
                              Current_Task_Instance_Seen;
                           end if;

                        --  Otherwise this is not the current instance

                        else
                           SPARK_Msg_N
                             ("invalid use of subtype mark in dependency "
                              & "relation", Item);
                        end if;

                     --  The dependency of a task unit on itself is implicit
                     --  and may or may not be explicitly specified
                     --  (SPARK RM 6.1.4).

                     elsif Is_Single_Task_Object (Item_Id)
                       and then Is_CCT_Instance (Etype (Item_Id), Spec_Id)
                     then
                        Current_Task_Instance_Seen;
                     end if;

                     --  Ensure that the item fulfills its role as input and/or
                     --  output as specified by pragma Global or the enclosing
                     --  context.

                     Check_Role (Item, Item_Id, Is_Input, Self_Ref);

                     --  Detect multiple uses of the same state, variable or
                     --  formal parameter. If this is not the case, add the
                     --  item to the list of processed relations.

                     if Contains (Seen, Item_Id) then
                        SPARK_Msg_NE
                          ("duplicate use of item &", Item, Item_Id);
                     else
                        Append_New_Elmt (Item_Id, Seen);
                     end if;

                     --  Detect illegal use of an input related to a null
                     --  output. Such input items cannot appear in other
                     --  input lists (SPARK RM 6.1.5(13)).

                     if Is_Input
                       and then Null_Output_Seen
                       and then Contains (All_Inputs_Seen, Item_Id)
                     then
                        SPARK_Msg_N
                          ("input of a null output list cannot appear in "
                           & "multiple input lists", Item);
                     end if;

                     --  Add an input or a self-referential output to the list
                     --  of all processed inputs.

                     if Is_Input or else Self_Ref then
                        Append_New_Elmt (Item_Id, All_Inputs_Seen);
                     end if;

                     --  State related checks (SPARK RM 6.1.5(3))

                     if Ekind (Item_Id) = E_Abstract_State then

                        --  Package and subprogram bodies are instantiated
                        --  individually in a separate compiler pass. Due to
                        --  this mode of instantiation, the refinement of a
                        --  state may no longer be visible when a subprogram
                        --  body contract is instantiated. Since the generic
                        --  template is legal, do not perform this check in
                        --  the instance to circumvent this oddity.

                        if Is_Generic_Instance (Spec_Id) then
                           null;

                        --  An abstract state with visible refinement cannot
                        --  appear in pragma [Refined_]Depends as its place
                        --  must be taken by some of its constituents
                        --  (SPARK RM 6.1.4(7)).

                        elsif Has_Visible_Refinement (Item_Id) then
                           SPARK_Msg_NE
                             ("cannot mention state & in dependence relation",
                              Item, Item_Id);
                           SPARK_Msg_N ("\use its constituents instead", Item);
                           return;

                        --  If the reference to the abstract state appears in
                        --  an enclosing package body that will eventually
                        --  refine the state, record the reference for future
                        --  checks.

                        else
                           Record_Possible_Body_Reference
                             (State_Id => Item_Id,
                              Ref      => Item);
                        end if;
                     end if;

                     --  When the item renames an entire object, replace the
                     --  item with a reference to the object.

                     if Entity (Item) /= Item_Id then
                        Rewrite (Item,
                          New_Occurrence_Of (Item_Id, Sloc (Item)));
                        Analyze (Item);
                     end if;

                     --  Add the entity of the current item to the list of
                     --  processed items.

                     if Ekind (Item_Id) = E_Abstract_State then
                        Append_New_Elmt (Item_Id, States_Seen);

                     --  The variable may eventually become a constituent of a
                     --  single protected/task type. Record the reference now
                     --  and verify its legality when analyzing the contract of
                     --  the variable (SPARK RM 9.3).

                     elsif Ekind (Item_Id) = E_Variable then
                        Record_Possible_Part_Of_Reference
                          (Var_Id => Item_Id,
                           Ref    => Item);
                     end if;

                     if Ekind_In (Item_Id, E_Abstract_State,
                                           E_Constant,
                                           E_Variable)
                       and then Present (Encapsulating_State (Item_Id))
                     then
                        Append_New_Elmt (Item_Id, Constits_Seen);
                     end if;

                  --  All other input/output items are illegal
                  --  (SPARK RM 6.1.5(1)).

                  else
                     SPARK_Msg_N
                       ("item must denote parameter, variable, state or "
                        & "current instance of concurrent type", Item);
                  end if;

               --  All other input/output items are illegal
               --  (SPARK RM 6.1.5(1)). This is a syntax error, always report.

               else
                  Error_Msg_N
                    ("item must denote parameter, variable, state or current "
                     & "instance of concurrent type", Item);
               end if;
            end if;
         end Analyze_Input_Output;

         --  Local variables

         Inputs   : Node_Id;
         Output   : Node_Id;
         Self_Ref : Boolean;

         Non_Null_Output_Seen : Boolean := False;
         --  Flag used to check the legality of an output list

      --  Start of processing for Analyze_Dependency_Clause

      begin
         Inputs   := Expression (Clause);
         Self_Ref := False;

         --  An input list with a self-dependency appears as operator "+" where
         --  the actuals inputs are the right operand.

         if Nkind (Inputs) = N_Op_Plus then
            Inputs   := Right_Opnd (Inputs);
            Self_Ref := True;
         end if;

         --  Process the output_list of a dependency_clause

         Output := First (Choices (Clause));
         while Present (Output) loop
            Analyze_Input_Output
              (Item          => Output,
               Is_Input      => False,
               Self_Ref      => Self_Ref,
               Top_Level     => True,
               Seen          => All_Outputs_Seen,
               Null_Seen     => Null_Output_Seen,
               Non_Null_Seen => Non_Null_Output_Seen);

            Next (Output);
         end loop;

         --  Process the input_list of a dependency_clause

         Analyze_Input_List (Inputs);
      end Analyze_Dependency_Clause;

      ---------------------------
      -- Check_Function_Return --
      ---------------------------

      procedure Check_Function_Return is
      begin
         if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
           and then not Result_Seen
         then
            SPARK_Msg_NE
              ("result of & must appear in exactly one output list",
               N, Spec_Id);
         end if;
      end Check_Function_Return;

      ----------------
      -- Check_Role --
      ----------------

      procedure Check_Role
        (Item     : Node_Id;
         Item_Id  : Entity_Id;
         Is_Input : Boolean;
         Self_Ref : Boolean)
      is
         procedure Find_Role
           (Item_Is_Input  : out Boolean;
            Item_Is_Output : out Boolean);
         --  Find the input/output role of Item_Id. Flags Item_Is_Input and
         --  Item_Is_Output are set depending on the role.

         procedure Role_Error
           (Item_Is_Input  : Boolean;
            Item_Is_Output : Boolean);
         --  Emit an error message concerning the incorrect use of Item in
         --  pragma [Refined_]Depends. Flags Item_Is_Input and Item_Is_Output
         --  denote whether the item is an input and/or an output.

         ---------------
         -- Find_Role --
         ---------------

         procedure Find_Role
           (Item_Is_Input  : out Boolean;
            Item_Is_Output : out Boolean)
         is
         begin
            case Ekind (Item_Id) is

               --  Abstract states

               when E_Abstract_State =>

                  --  When pragma Global is present it determines the mode of
                  --  the abstract state.

                  if Global_Seen then
                     Item_Is_Input  := Appears_In (Subp_Inputs, Item_Id);
                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);

                  --  Otherwise the state has a default IN OUT mode, because it
                  --  behaves as a variable.

                  else
                     Item_Is_Input  := True;
                     Item_Is_Output := True;
                  end if;

               --  Constants and IN parameters

               when E_Constant
                  | E_Generic_In_Parameter
                  | E_In_Parameter
                  | E_Loop_Parameter
               =>
                  --  When pragma Global is present it determines the mode
                  --  of constant objects as inputs (and such objects cannot
                  --  appear as outputs in the Global contract).

                  if Global_Seen then
                     Item_Is_Input := Appears_In (Subp_Inputs, Item_Id);
                  else
                     Item_Is_Input := True;
                  end if;

                  Item_Is_Output := False;

               --  Variables and IN OUT parameters

               when E_Generic_In_Out_Parameter
                  | E_In_Out_Parameter
                  | E_Variable
               =>
                  --  When pragma Global is present it determines the mode of
                  --  the object.

                  if Global_Seen then

                     --  A variable has mode IN when its type is unconstrained
                     --  or tagged because array bounds, discriminants or tags
                     --  can be read.

                     Item_Is_Input :=
                       Appears_In (Subp_Inputs, Item_Id)
                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);

                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);

                  --  Otherwise the variable has a default IN OUT mode

                  else
                     Item_Is_Input  := True;
                     Item_Is_Output := True;
                  end if;

               when E_Out_Parameter =>

                  --  An OUT parameter of the related subprogram; it cannot
                  --  appear in Global.

                  if Scope (Item_Id) = Spec_Id then

                     --  The parameter has mode IN if its type is unconstrained
                     --  or tagged because array bounds, discriminants or tags
                     --  can be read.

                     Item_Is_Input :=
                       Is_Unconstrained_Or_Tagged_Item (Item_Id);

                     Item_Is_Output := True;

                  --  An OUT parameter of an enclosing subprogram; it can
                  --  appear in Global and behaves as a read-write variable.

                  else
                     --  When pragma Global is present it determines the mode
                     --  of the object.

                     if Global_Seen then

                        --  A variable has mode IN when its type is
                        --  unconstrained or tagged because array
                        --  bounds, discriminants or tags can be read.

                        Item_Is_Input :=
                          Appears_In (Subp_Inputs, Item_Id)
                            or else Is_Unconstrained_Or_Tagged_Item (Item_Id);

                        Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);

                     --  Otherwise the variable has a default IN OUT mode

                     else
                        Item_Is_Input  := True;
                        Item_Is_Output := True;
                     end if;
                  end if;

               --  Protected types

               when E_Protected_Type =>
                  if Global_Seen then

                     --  A variable has mode IN when its type is unconstrained
                     --  or tagged because array bounds, discriminants or tags
                     --  can be read.

                     Item_Is_Input :=
                       Appears_In (Subp_Inputs, Item_Id)
                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);

                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);

                  else
                     --  A protected type acts as a formal parameter of mode IN
                     --  when it applies to a protected function.

                     if Ekind (Spec_Id) = E_Function then
                        Item_Is_Input  := True;
                        Item_Is_Output := False;

                     --  Otherwise the protected type acts as a formal of mode
                     --  IN OUT.

                     else
                        Item_Is_Input  := True;
                        Item_Is_Output := True;
                     end if;
                  end if;

               --  Task types

               when E_Task_Type =>

                  --  When pragma Global is present it determines the mode of
                  --  the object.

                  if Global_Seen then
                     Item_Is_Input :=
                       Appears_In (Subp_Inputs, Item_Id)
                         or else Is_Unconstrained_Or_Tagged_Item (Item_Id);

                     Item_Is_Output := Appears_In (Subp_Outputs, Item_Id);

                  --  Otherwise task types act as IN OUT parameters

                  else
                     Item_Is_Input  := True;
                     Item_Is_Output := True;
                  end if;

               when others =>
                  raise Program_Error;
            end case;
         end Find_Role;

         ----------------
         -- Role_Error --
         ----------------

         procedure Role_Error
           (Item_Is_Input  : Boolean;
            Item_Is_Output : Boolean)
         is
            Error_Msg : Name_Id;

         begin
            Name_Len := 0;

            --  When the item is not part of the input and the output set of
            --  the related subprogram, then it appears as extra in pragma
            --  [Refined_]Depends.

            if not Item_Is_Input and then not Item_Is_Output then
               Add_Item_To_Name_Buffer (Item_Id);
               Add_Str_To_Name_Buffer
                 (" & cannot appear in dependence relation");

               Error_Msg := Name_Find;
               SPARK_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id);

               Error_Msg_Name_1 := Chars (Spec_Id);
               SPARK_Msg_NE
                 (Fix_Msg (Spec_Id, "\& is not part of the input or output "
                  & "set of subprogram %"), Item, Item_Id);

            --  The mode of the item and its role in pragma [Refined_]Depends
            --  are in conflict. Construct a detailed message explaining the
            --  illegality (SPARK RM 6.1.5(5-6)).

            else
               if Item_Is_Input then
                  Add_Str_To_Name_Buffer ("read-only");
               else
                  Add_Str_To_Name_Buffer ("write-only");
               end if;

               Add_Char_To_Name_Buffer (' ');
               Add_Item_To_Name_Buffer (Item_Id);
               Add_Str_To_Name_Buffer  (" & cannot appear as ");

               if Item_Is_Input then
                  Add_Str_To_Name_Buffer ("output");
               else
                  Add_Str_To_Name_Buffer ("input");
               end if;

               Add_Str_To_Name_Buffer (" in dependence relation");
               Error_Msg := Name_Find;
               SPARK_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id);
            end if;
         end Role_Error;

         --  Local variables

         Item_Is_Input  : Boolean;
         Item_Is_Output : Boolean;

      --  Start of processing for Check_Role

      begin
         Find_Role (Item_Is_Input, Item_Is_Output);

         --  Input item

         if Is_Input then
            if not Item_Is_Input then
               Role_Error (Item_Is_Input, Item_Is_Output);
            end if;

         --  Self-referential item

         elsif Self_Ref then
            if not Item_Is_Input or else not Item_Is_Output then
               Role_Error (Item_Is_Input, Item_Is_Output);
            end if;

         --  Output item

         elsif not Item_Is_Output then
            Role_Error (Item_Is_Input, Item_Is_Output);
         end if;
      end Check_Role;

      -----------------
      -- Check_Usage --
      -----------------

      procedure Check_Usage
        (Subp_Items : Elist_Id;
         Used_Items : Elist_Id;
         Is_Input   : Boolean)
      is
         procedure Usage_Error (Item_Id : Entity_Id);
         --  Emit an error concerning the illegal usage of an item

         -----------------
         -- Usage_Error --
         -----------------

         procedure Usage_Error (Item_Id : Entity_Id) is
            Error_Msg : Name_Id;

         begin
            --  Input case

            if Is_Input then

               --  Unconstrained and tagged items are not part of the explicit
               --  input set of the related subprogram, they do not have to be
               --  present in a dependence relation and should not be flagged
               --  (SPARK RM 6.1.5(5)).

               if not Is_Unconstrained_Or_Tagged_Item (Item_Id) then
                  Name_Len := 0;

                  Add_Item_To_Name_Buffer (Item_Id);
                  Add_Str_To_Name_Buffer
                    (" & is missing from input dependence list");

                  Error_Msg := Name_Find;
                  SPARK_Msg_NE (Get_Name_String (Error_Msg), N, Item_Id);
                  SPARK_Msg_NE
                    ("\add `null ='> &` dependency to ignore this input",
                     N, Item_Id);
               end if;

            --  Output case (SPARK RM 6.1.5(10))

            else
               Name_Len := 0;

               Add_Item_To_Name_Buffer (Item_Id);
               Add_Str_To_Name_Buffer
                 (" & is missing from output dependence list");

               Error_Msg := Name_Find;
               SPARK_Msg_NE (Get_Name_String (Error_Msg), N, Item_Id);
            end if;
         end Usage_Error;

         --  Local variables

         Elmt    : Elmt_Id;
         Item    : Node_Id;
         Item_Id : Entity_Id;

      --  Start of processing for Check_Usage

      begin
         if No (Subp_Items) then
            return;
         end if;

         --  Each input or output of the subprogram must appear in a dependency
         --  relation.

         Elmt := First_Elmt (Subp_Items);
         while Present (Elmt) loop
            Item := Node (Elmt);

            if Nkind (Item) = N_Defining_Identifier then
               Item_Id := Item;
            else
               Item_Id := Entity_Of (Item);
            end if;

            --  The item does not appear in a dependency

            if Present (Item_Id)
              and then not Contains (Used_Items, Item_Id)
            then
               if Is_Formal (Item_Id) then
                  Usage_Error (Item_Id);

               --  The current instance of a protected type behaves as a formal
               --  parameter (SPARK RM 6.1.4).

               elsif Ekind (Item_Id) = E_Protected_Type
                 or else Is_Single_Protected_Object (Item_Id)
               then
                  Usage_Error (Item_Id);

               --  The current instance of a task type behaves as a formal
               --  parameter (SPARK RM 6.1.4).

               elsif Ekind (Item_Id) = E_Task_Type
                 or else Is_Single_Task_Object (Item_Id)
               then
                  --  The dependence of a task unit on itself is implicit and
                  --  may or may not be explicitly specified (SPARK RM 6.1.4).
                  --  Emit an error if only one input/output is present.

                  if Task_Input_Seen /= Task_Output_Seen then
                     Usage_Error (Item_Id);
                  end if;

               --  States and global objects are not used properly only when
               --  the subprogram is subject to pragma Global.

               elsif Global_Seen then
                  Usage_Error (Item_Id);
               end if;
            end if;

            Next_Elmt (Elmt);
         end loop;
      end Check_Usage;

      ----------------------
      -- Normalize_Clause --
      ----------------------

      procedure Normalize_Clause (Clause : Node_Id) is
         procedure Create_Or_Modify_Clause
           (Output   : Node_Id;
            Outputs  : Node_Id;
            Inputs   : Node_Id;
            After    : Node_Id;
            In_Place : Boolean;
            Multiple : Boolean);
         --  Create a brand new clause to represent the self-reference or
         --  modify the input and/or output lists of an existing clause. Output
         --  denotes a self-referencial output. Outputs is the output list of a
         --  clause. Inputs is the input list of a clause. After denotes the
         --  clause after which the new clause is to be inserted. Flag In_Place
         --  should be set when normalizing the last output of an output list.
         --  Flag Multiple should be set when Output comes from a list with
         --  multiple items.

         -----------------------------
         -- Create_Or_Modify_Clause --
         -----------------------------

         procedure Create_Or_Modify_Clause
           (Output   : Node_Id;
            Outputs  : Node_Id;
            Inputs   : Node_Id;
            After    : Node_Id;
            In_Place : Boolean;
            Multiple : Boolean)
         is
            procedure Propagate_Output
              (Output : Node_Id;
               Inputs : Node_Id);
            --  Handle the various cases of output propagation to the input
            --  list. Output denotes a self-referencial output item. Inputs
            --  is the input list of a clause.

            ----------------------
            -- Propagate_Output --
            ----------------------

            procedure Propagate_Output
              (Output : Node_Id;
               Inputs : Node_Id)
            is
               function In_Input_List
                 (Item   : Entity_Id;
                  Inputs : List_Id) return Boolean;
               --  Determine whether a particulat item appears in the input
               --  list of a clause.

               -------------------
               -- In_Input_List --
               -------------------

               function In_Input_List
                 (Item   : Entity_Id;
                  Inputs : List_Id) return Boolean
               is
                  Elmt : Node_Id;

               begin
                  Elmt := First (Inputs);
                  while Present (Elmt) loop
                     if Entity_Of (Elmt) = Item then
                        return True;
                     end if;

                     Next (Elmt);
                  end loop;

                  return False;
               end In_Input_List;

               --  Local variables

               Output_Id : constant Entity_Id := Entity_Of (Output);
               Grouped   : List_Id;

            --  Start of processing for Propagate_Output

            begin
               --  The clause is of the form:

               --    (Output =>+ null)

               --  Remove null input and replace it with a copy of the output:

               --    (Output => Output)

               if Nkind (Inputs) = N_Null then
                  Rewrite (Inputs, New_Copy_Tree (Output));

               --  The clause is of the form:

               --    (Output =>+ (Input1, ..., InputN))

               --  Determine whether the output is not already mentioned in the
               --  input list and if not, add it to the list of inputs:

               --    (Output => (Output, Input1, ..., InputN))

               elsif Nkind (Inputs) = N_Aggregate then
                  Grouped := Expressions (Inputs);

                  if not In_Input_List
                           (Item   => Output_Id,
                            Inputs => Grouped)
                  then
                     Prepend_To (Grouped, New_Copy_Tree (Output));
                  end if;

               --  The clause is of the form:

               --    (Output =>+ Input)

               --  If the input does not mention the output, group the two
               --  together:

               --    (Output => (Output, Input))

               elsif Entity_Of (Inputs) /= Output_Id then
                  Rewrite (Inputs,
                    Make_Aggregate (Loc,
                      Expressions => New_List (
                        New_Copy_Tree (Output),
                        New_Copy_Tree (Inputs))));
               end if;
            end Propagate_Output;

            --  Local variables

            Loc        : constant Source_Ptr := Sloc (Clause);
            New_Clause : Node_Id;

         --  Start of processing for Create_Or_Modify_Clause

         begin
            --  A null output depending on itself does not require any
            --  normalization.

            if Nkind (Output) = N_Null then
               return;

            --  A function result cannot depend on itself because it cannot
            --  appear in the input list of a relation (SPARK RM 6.1.5(10)).

            elsif Is_Attribute_Result (Output) then
               SPARK_Msg_N ("function result cannot depend on itself", Output);
               return;
            end if;

            --  When performing the transformation in place, simply add the
            --  output to the list of inputs (if not already there). This
            --  case arises when dealing with the last output of an output
            --  list. Perform the normalization in place to avoid generating
            --  a malformed tree.

            if In_Place then
               Propagate_Output (Output, Inputs);

               --  A list with multiple outputs is slowly trimmed until only
               --  one element remains. When this happens, replace aggregate
               --  with the element itself.

               if Multiple then
                  Remove  (Output);
                  Rewrite (Outputs, Output);
               end if;

            --  Default case

            else
               --  Unchain the output from its output list as it will appear in
               --  a new clause. Note that we cannot simply rewrite the output
               --  as null because this will violate the semantics of pragma
               --  Depends.

               Remove (Output);

               --  Generate a new clause of the form:
               --    (Output => Inputs)

               New_Clause :=
                 Make_Component_Association (Loc,
                   Choices    => New_List (Output),
                   Expression => New_Copy_Tree (Inputs));

               --  The new clause contains replicated content that has already
               --  been analyzed. There is not need to reanalyze or renormalize
               --  it again.

               Set_Analyzed (New_Clause);

               Propagate_Output
                 (Output => First (Choices (New_Clause)),
                  Inputs => Expression (New_Clause));

               Insert_After (After, New_Clause);
            end if;
         end Create_Or_Modify_Clause;

         --  Local variables

         Outputs     : constant Node_Id := First (Choices (Clause));
         Inputs      : Node_Id;
         Last_Output : Node_Id;
         Next_Output : Node_Id;
         Output      : Node_Id;

      --  Start of processing for Normalize_Clause

      begin
         --  A self-dependency appears as operator "+". Remove the "+" from the
         --  tree by moving the real inputs to their proper place.

         if Nkind (Expression (Clause)) = N_Op_Plus then
            Rewrite (Expression (Clause), Right_Opnd (Expression (Clause)));
            Inputs := Expression (Clause);

            --  Multiple outputs appear as an aggregate

            if Nkind (Outputs) = N_Aggregate then
               Last_Output := Last (Expressions (Outputs));

               Output := First (Expressions (Outputs));
               while Present (Output) loop

                  --  Normalization may remove an output from its list,
                  --  preserve the subsequent output now.

                  Next_Output := Next (Output);

                  Create_Or_Modify_Clause
                    (Output   => Output,
                     Outputs  => Outputs,
                     Inputs   => Inputs,
                     After    => Clause,
                     In_Place => Output = Last_Output,
                     Multiple => True);

                  Output := Next_Output;
               end loop;

            --  Solitary output

            else
               Create_Or_Modify_Clause
                 (Output   => Outputs,
                  Outputs  => Empty,
                  Inputs   => Inputs,
                  After    => Empty,
                  In_Place => True,
                  Multiple => False);
            end if;
         end if;
      end Normalize_Clause;

      --  Local variables

      Deps    : constant Node_Id   := Expression (Get_Argument (N, Spec_Id));
      Subp_Id : constant Entity_Id := Defining_Entity (Subp_Decl);

      Clause        : Node_Id;
      Errors        : Nat;
      Last_Clause   : Node_Id;
      Restore_Scope : Boolean := False;

   --  Start of processing for Analyze_Depends_In_Decl_Part

   begin
      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      --  Empty dependency list

      if Nkind (Deps) = N_Null then

         --  Gather all states, objects and formal parameters that the
         --  subprogram may depend on. These items are obtained from the
         --  parameter profile or pragma [Refined_]Global (if available).

         Collect_Subprogram_Inputs_Outputs
           (Subp_Id      => Subp_Id,
            Subp_Inputs  => Subp_Inputs,
            Subp_Outputs => Subp_Outputs,
            Global_Seen  => Global_Seen);

         --  Verify that every input or output of the subprogram appear in a
         --  dependency.

         Check_Usage (Subp_Inputs, All_Inputs_Seen, True);
         Check_Usage (Subp_Outputs, All_Outputs_Seen, False);
         Check_Function_Return;

      --  Dependency clauses appear as component associations of an aggregate

      elsif Nkind (Deps) = N_Aggregate then

         --  Do not attempt to perform analysis of a syntactically illegal
         --  clause as this will lead to misleading errors.

         if Has_Extra_Parentheses (Deps) then
            return;
         end if;

         if Present (Component_Associations (Deps)) then
            Last_Clause := Last (Component_Associations (Deps));

            --  Gather all states, objects and formal parameters that the
            --  subprogram may depend on. These items are obtained from the
            --  parameter profile or pragma [Refined_]Global (if available).

            Collect_Subprogram_Inputs_Outputs
              (Subp_Id      => Subp_Id,
               Subp_Inputs  => Subp_Inputs,
               Subp_Outputs => Subp_Outputs,
               Global_Seen  => Global_Seen);

            --  When pragma [Refined_]Depends appears on a single concurrent
            --  type, it is relocated to the anonymous object.

            if Is_Single_Concurrent_Object (Spec_Id) then
               null;

            --  Ensure that the formal parameters are visible when analyzing
            --  all clauses. This falls out of the general rule of aspects
            --  pertaining to subprogram declarations.

            elsif not In_Open_Scopes (Spec_Id) then
               Restore_Scope := True;
               Push_Scope (Spec_Id);

               if Ekind (Spec_Id) = E_Task_Type then
                  if Has_Discriminants (Spec_Id) then
                     Install_Discriminants (Spec_Id);
                  end if;

               elsif Is_Generic_Subprogram (Spec_Id) then
                  Install_Generic_Formals (Spec_Id);

               else
                  Install_Formals (Spec_Id);
               end if;
            end if;

            Clause := First (Component_Associations (Deps));
            while Present (Clause) loop
               Errors := Serious_Errors_Detected;

               --  The normalization mechanism may create extra clauses that
               --  contain replicated input and output names. There is no need
               --  to reanalyze them.

               if not Analyzed (Clause) then
                  Set_Analyzed (Clause);

                  Analyze_Dependency_Clause
                    (Clause  => Clause,
                     Is_Last => Clause = Last_Clause);
               end if;

               --  Do not normalize a clause if errors were detected (count
               --  of Serious_Errors has increased) because the inputs and/or
               --  outputs may denote illegal items. Normalization is disabled
               --  in ASIS mode as it alters the tree by introducing new nodes
               --  similar to expansion.

               if Serious_Errors_Detected = Errors and then not ASIS_Mode then
                  Normalize_Clause (Clause);
               end if;

               Next (Clause);
            end loop;

            if Restore_Scope then
               End_Scope;
            end if;

            --  Verify that every input or output of the subprogram appear in a
            --  dependency.

            Check_Usage (Subp_Inputs, All_Inputs_Seen, True);
            Check_Usage (Subp_Outputs, All_Outputs_Seen, False);
            Check_Function_Return;

         --  The dependency list is malformed. This is a syntax error, always
         --  report.

         else
            Error_Msg_N ("malformed dependency relation", Deps);
            return;
         end if;

      --  The top level dependency relation is malformed. This is a syntax
      --  error, always report.

      else
         Error_Msg_N ("malformed dependency relation", Deps);
         goto Leave;
      end if;

      --  Ensure that a state and a corresponding constituent do not appear
      --  together in pragma [Refined_]Depends.

      Check_State_And_Constituent_Use
        (States   => States_Seen,
         Constits => Constits_Seen,
         Context  => N);

      <<Leave>>
      Set_Is_Analyzed_Pragma (N);
   end Analyze_Depends_In_Decl_Part;

   --------------------------------------------
   -- Analyze_External_Property_In_Decl_Part --
   --------------------------------------------

   procedure Analyze_External_Property_In_Decl_Part
     (N        : Node_Id;
      Expr_Val : out Boolean)
   is
      Arg1     : constant Node_Id   :=
                   First (Pragma_Argument_Associations (N));
      Obj_Decl : constant Node_Id   := Find_Related_Context (N);
      Obj_Id   : constant Entity_Id := Defining_Entity (Obj_Decl);
      Expr     : Node_Id;

   begin
      Expr_Val := False;

      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      Error_Msg_Name_1 := Pragma_Name (N);

      --  An external property pragma must apply to an effectively volatile
      --  object other than a formal subprogram parameter (SPARK RM 7.1.3(2)).
      --  The check is performed at the end of the declarative region due to a
      --  possible out-of-order arrangement of pragmas:

      --    Obj : ...;
      --    pragma Async_Readers (Obj);
      --    pragma Volatile (Obj);

      if not Is_Effectively_Volatile (Obj_Id) then
         SPARK_Msg_N
           ("external property % must apply to a volatile object", N);
      end if;

      --  Ensure that the Boolean expression (if present) is static. A missing
      --  argument defaults the value to True (SPARK RM 7.1.2(5)).

      Expr_Val := True;

      if Present (Arg1) then
         Expr := Get_Pragma_Arg (Arg1);

         if Is_OK_Static_Expression (Expr) then
            Expr_Val := Is_True (Expr_Value (Expr));
         end if;
      end if;

      Set_Is_Analyzed_Pragma (N);
   end Analyze_External_Property_In_Decl_Part;

   ---------------------------------
   -- Analyze_Global_In_Decl_Part --
   ---------------------------------

   procedure Analyze_Global_In_Decl_Part (N : Node_Id) is
      Subp_Decl : constant Node_Id   := Find_Related_Declaration_Or_Body (N);
      Spec_Id   : constant Entity_Id := Unique_Defining_Entity (Subp_Decl);
      Subp_Id   : constant Entity_Id := Defining_Entity (Subp_Decl);

      Constits_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all constituents processed so far.
      --  It aids in detecting illegal usage of a state and a corresponding
      --  constituent in pragma [Refinde_]Global.

      Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all the items processed so far. It
      --  plays a role in detecting distinct entities.

      States_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all states processed so far. It
      --  helps in detecting illegal usage of a state and a corresponding
      --  constituent in pragma [Refined_]Global.

      In_Out_Seen : Boolean := False;
      Input_Seen  : Boolean := False;
      Output_Seen : Boolean := False;
      Proof_Seen  : Boolean := False;
      --  Flags used to verify the consistency of modes

      procedure Analyze_Global_List
        (List        : Node_Id;
         Global_Mode : Name_Id := Name_Input);
      --  Verify the legality of a single global list declaration. Global_Mode
      --  denotes the current mode in effect.

      -------------------------
      -- Analyze_Global_List --
      -------------------------

      procedure Analyze_Global_List
        (List        : Node_Id;
         Global_Mode : Name_Id := Name_Input)
      is
         procedure Analyze_Global_Item
           (Item        : Node_Id;
            Global_Mode : Name_Id);
         --  Verify the legality of a single global item declaration denoted by
         --  Item. Global_Mode denotes the current mode in effect.

         procedure Check_Duplicate_Mode
           (Mode   : Node_Id;
            Status : in out Boolean);
         --  Flag Status denotes whether a particular mode has been seen while
         --  processing a global list. This routine verifies that Mode is not a
         --  duplicate mode and sets the flag Status (SPARK RM 6.1.4(9)).

         procedure Check_Mode_Restriction_In_Enclosing_Context
           (Item    : Node_Id;
            Item_Id : Entity_Id);
         --  Verify that an item of mode In_Out or Output does not appear as
         --  an input in the Global aspect of an enclosing subprogram or task
         --  unit. If this is the case, emit an error. Item and Item_Id are
         --  respectively the item and its entity.

         procedure Check_Mode_Restriction_In_Function (Mode : Node_Id);
         --  Mode denotes either In_Out or Output. Depending on the kind of the
         --  related subprogram, emit an error if those two modes apply to a
         --  function (SPARK RM 6.1.4(10)).

         -------------------------
         -- Analyze_Global_Item --
         -------------------------

         procedure Analyze_Global_Item
           (Item        : Node_Id;
            Global_Mode : Name_Id)
         is
            Item_Id : Entity_Id;

         begin
            --  Detect one of the following cases

            --    with Global => (null, Name)
            --    with Global => (Name_1, null, Name_2)
            --    with Global => (Name, null)

            if Nkind (Item) = N_Null then
               SPARK_Msg_N ("cannot mix null and non-null global items", Item);
               return;
            end if;

            Analyze       (Item);
            Resolve_State (Item);

            --  Find the entity of the item. If this is a renaming, climb the
            --  renaming chain to reach the root object. Renamings of non-
            --  entire objects do not yield an entity (Empty).

            Item_Id := Entity_Of (Item);

            if Present (Item_Id) then

               --  A global item may denote a formal parameter of an enclosing
               --  subprogram (SPARK RM 6.1.4(6)). Do this check first to
               --  provide a better error diagnostic.

               if Is_Formal (Item_Id) then
                  if Scope (Item_Id) = Spec_Id then
                     SPARK_Msg_NE
                       (Fix_Msg (Spec_Id, "global item cannot reference "
                        & "parameter of subprogram &"), Item, Spec_Id);
                     return;
                  end if;

               --  A global item may denote a concurrent type as long as it is
               --  the current instance of an enclosing protected or task type
               --  (SPARK RM 6.1.4).

               elsif Ekind_In (Item_Id, E_Protected_Type, E_Task_Type) then
                  if Is_CCT_Instance (Item_Id, Spec_Id) then

                     --  Pragma [Refined_]Global associated with a protected
                     --  subprogram cannot mention the current instance of a
                     --  protected type because the instance behaves as a
                     --  formal parameter.

                     if Ekind (Item_Id) = E_Protected_Type then
                        if Scope (Spec_Id) = Item_Id then
                           Error_Msg_Name_1 := Chars (Item_Id);
                           SPARK_Msg_NE
                             (Fix_Msg (Spec_Id, "global item of subprogram & "
                              & "cannot reference current instance of "
                              & "protected type %"), Item, Spec_Id);
                           return;
                        end if;

                     --  Pragma [Refined_]Global associated with a task type
                     --  cannot mention the current instance of a task type
                     --  because the instance behaves as a formal parameter.

                     else pragma Assert (Ekind (Item_Id) = E_Task_Type);
                        if Spec_Id = Item_Id then
                           Error_Msg_Name_1 := Chars (Item_Id);
                           SPARK_Msg_NE
                             (Fix_Msg (Spec_Id, "global item of subprogram & "
                              & "cannot reference current instance of task "
                              & "type %"), Item, Spec_Id);
                           return;
                        end if;
                     end if;

                  --  Otherwise the global item denotes a subtype mark that is
                  --  not a current instance.

                  else
                     SPARK_Msg_N
                       ("invalid use of subtype mark in global list", Item);
                     return;
                  end if;

               --  A global item may denote the anonymous object created for a
               --  single protected/task type as long as the current instance
               --  is the same single type (SPARK RM 6.1.4).

               elsif Is_Single_Concurrent_Object (Item_Id)
                 and then Is_CCT_Instance (Etype (Item_Id), Spec_Id)
               then
                  --  Pragma [Refined_]Global associated with a protected
                  --  subprogram cannot mention the current instance of a
                  --  protected type because the instance behaves as a formal
                  --  parameter.

                  if Is_Single_Protected_Object (Item_Id) then
                     if Scope (Spec_Id) = Etype (Item_Id) then
                        Error_Msg_Name_1 := Chars (Item_Id);
                        SPARK_Msg_NE
                          (Fix_Msg (Spec_Id, "global item of subprogram & "
                           & "cannot reference current instance of protected "
                           & "type %"), Item, Spec_Id);
                        return;
                     end if;

                  --  Pragma [Refined_]Global associated with a task type
                  --  cannot mention the current instance of a task type
                  --  because the instance behaves as a formal parameter.

                  else pragma Assert (Is_Single_Task_Object (Item_Id));
                     if Spec_Id = Item_Id then
                        Error_Msg_Name_1 := Chars (Item_Id);
                        SPARK_Msg_NE
                          (Fix_Msg (Spec_Id, "global item of subprogram & "
                           & "cannot reference current instance of task "
                           & "type %"), Item, Spec_Id);
                        return;
                     end if;
                  end if;

               --  A formal object may act as a global item inside a generic

               elsif Is_Formal_Object (Item_Id) then
                  null;

               --  The only legal references are those to abstract states,
               --  objects and various kinds of constants (SPARK RM 6.1.4(4)).

               elsif not Ekind_In (Item_Id, E_Abstract_State,
                                            E_Constant,
                                            E_Loop_Parameter,
                                            E_Variable)
               then
                  SPARK_Msg_N
                    ("global item must denote object, state or current "
                     & "instance of concurrent type", Item);
                  return;
               end if;

               --  State related checks

               if Ekind (Item_Id) = E_Abstract_State then

                  --  Package and subprogram bodies are instantiated
                  --  individually in a separate compiler pass. Due to this
                  --  mode of instantiation, the refinement of a state may
                  --  no longer be visible when a subprogram body contract
                  --  is instantiated. Since the generic template is legal,
                  --  do not perform this check in the instance to circumvent
                  --  this oddity.

                  if Is_Generic_Instance (Spec_Id) then
                     null;

                  --  An abstract state with visible refinement cannot appear
                  --  in pragma [Refined_]Global as its place must be taken by
                  --  some of its constituents (SPARK RM 6.1.4(7)).

                  elsif Has_Visible_Refinement (Item_Id) then
                     SPARK_Msg_NE
                       ("cannot mention state & in global refinement",
                        Item, Item_Id);
                     SPARK_Msg_N ("\use its constituents instead", Item);
                     return;

                  --  An external state cannot appear as a global item of a
                  --  nonvolatile function (SPARK RM 7.1.3(8)).

                  elsif Is_External_State (Item_Id)
                    and then Ekind_In (Spec_Id, E_Function, E_Generic_Function)
                    and then not Is_Volatile_Function (Spec_Id)
                  then
                     SPARK_Msg_NE
                       ("external state & cannot act as global item of "
                        & "nonvolatile function", Item, Item_Id);
                     return;

                  --  If the reference to the abstract state appears in an
                  --  enclosing package body that will eventually refine the
                  --  state, record the reference for future checks.

                  else
                     Record_Possible_Body_Reference
                       (State_Id => Item_Id,
                        Ref      => Item);
                  end if;

               --  Constant related checks

               elsif Ekind (Item_Id) = E_Constant then

                  --  A constant is a read-only item, therefore it cannot act
                  --  as an output.

                  if Nam_In (Global_Mode, Name_In_Out, Name_Output) then
                     SPARK_Msg_NE
                       ("constant & cannot act as output", Item, Item_Id);
                     return;
                  end if;

               --  Loop parameter related checks

               elsif Ekind (Item_Id) = E_Loop_Parameter then

                  --  A loop parameter is a read-only item, therefore it cannot
                  --  act as an output.

                  if Nam_In (Global_Mode, Name_In_Out, Name_Output) then
                     SPARK_Msg_NE
                       ("loop parameter & cannot act as output",
                        Item, Item_Id);
                     return;
                  end if;

               --  Variable related checks. These are only relevant when
               --  SPARK_Mode is on as they are not standard Ada legality
               --  rules.

               elsif SPARK_Mode = On
                 and then Ekind (Item_Id) = E_Variable
                 and then Is_Effectively_Volatile (Item_Id)
               then
                  --  An effectively volatile object cannot appear as a global
                  --  item of a nonvolatile function (SPARK RM 7.1.3(8)).

                  if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
                    and then not Is_Volatile_Function (Spec_Id)
                  then
                     Error_Msg_NE
                       ("volatile object & cannot act as global item of a "
                        & "function", Item, Item_Id);
                     return;

                  --  An effectively volatile object with external property
                  --  Effective_Reads set to True must have mode Output or
                  --  In_Out (SPARK RM 7.1.3(10)).

                  elsif Effective_Reads_Enabled (Item_Id)
                    and then Global_Mode = Name_Input
                  then
                     Error_Msg_NE
                       ("volatile object & with property Effective_Reads must "
                        & "have mode In_Out or Output", Item, Item_Id);
                     return;
                  end if;
               end if;

               --  When the item renames an entire object, replace the item
               --  with a reference to the object.

               if Entity (Item) /= Item_Id then
                  Rewrite (Item, New_Occurrence_Of (Item_Id, Sloc (Item)));
                  Analyze (Item);
               end if;

            --  Some form of illegal construct masquerading as a name
            --  (SPARK RM 6.1.4(4)).

            else
               Error_Msg_N
                 ("global item must denote object, state or current instance "
                  & "of concurrent type", Item);
               return;
            end if;

            --  Verify that an output does not appear as an input in an
            --  enclosing subprogram.

            if Nam_In (Global_Mode, Name_In_Out, Name_Output) then
               Check_Mode_Restriction_In_Enclosing_Context (Item, Item_Id);
            end if;

            --  The same entity might be referenced through various way.
            --  Check the entity of the item rather than the item itself
            --  (SPARK RM 6.1.4(10)).

            if Contains (Seen, Item_Id) then
               SPARK_Msg_N ("duplicate global item", Item);

            --  Add the entity of the current item to the list of processed
            --  items.

            else
               Append_New_Elmt (Item_Id, Seen);

               if Ekind (Item_Id) = E_Abstract_State then
                  Append_New_Elmt (Item_Id, States_Seen);

               --  The variable may eventually become a constituent of a single
               --  protected/task type. Record the reference now and verify its
               --  legality when analyzing the contract of the variable
               --  (SPARK RM 9.3).

               elsif Ekind (Item_Id) = E_Variable then
                  Record_Possible_Part_Of_Reference
                    (Var_Id => Item_Id,
                     Ref    => Item);
               end if;

               if Ekind_In (Item_Id, E_Abstract_State, E_Constant, E_Variable)
                 and then Present (Encapsulating_State (Item_Id))
               then
                  Append_New_Elmt (Item_Id, Constits_Seen);
               end if;
            end if;
         end Analyze_Global_Item;

         --------------------------
         -- Check_Duplicate_Mode --
         --------------------------

         procedure Check_Duplicate_Mode
           (Mode   : Node_Id;
            Status : in out Boolean)
         is
         begin
            if Status then
               SPARK_Msg_N ("duplicate global mode", Mode);
            end if;

            Status := True;
         end Check_Duplicate_Mode;

         -------------------------------------------------
         -- Check_Mode_Restriction_In_Enclosing_Context --
         -------------------------------------------------

         procedure Check_Mode_Restriction_In_Enclosing_Context
           (Item    : Node_Id;
            Item_Id : Entity_Id)
         is
            Context : Entity_Id;
            Dummy   : Boolean;
            Inputs  : Elist_Id := No_Elist;
            Outputs : Elist_Id := No_Elist;

         begin
            --  Traverse the scope stack looking for enclosing subprograms or
            --  tasks subject to pragma [Refined_]Global.

            Context := Scope (Subp_Id);
            while Present (Context) and then Context /= Standard_Standard loop

               --  For a single task type, retrieve the corresponding object to
               --  which pragma [Refined_]Global is attached.

               if Ekind (Context) = E_Task_Type
                 and then Is_Single_Concurrent_Type (Context)
               then
                  Context := Anonymous_Object (Context);
               end if;

               if (Is_Subprogram (Context)
                     or else Ekind (Context) = E_Task_Type
                     or else Is_Single_Task_Object (Context))
                 and then
                  (Present (Get_Pragma (Context, Pragma_Global))
                     or else
                   Present (Get_Pragma (Context, Pragma_Refined_Global)))
               then
                  Collect_Subprogram_Inputs_Outputs
                    (Subp_Id      => Context,
                     Subp_Inputs  => Inputs,
                     Subp_Outputs => Outputs,
                     Global_Seen  => Dummy);

                  --  The item is classified as In_Out or Output but appears as
                  --  an Input in an enclosing subprogram or task unit (SPARK
                  --  RM 6.1.4(12)).

                  if Appears_In (Inputs, Item_Id)
                    and then not Appears_In (Outputs, Item_Id)
                  then
                     SPARK_Msg_NE
                       ("global item & cannot have mode In_Out or Output",
                        Item, Item_Id);

                     if Is_Subprogram (Context) then
                        SPARK_Msg_NE
                          (Fix_Msg (Subp_Id, "\item already appears as input "
                           & "of subprogram &"), Item, Context);
                     else
                        SPARK_Msg_NE
                          (Fix_Msg (Subp_Id, "\item already appears as input "
                           & "of task &"), Item, Context);
                     end if;

                     --  Stop the traversal once an error has been detected

                     exit;
                  end if;
               end if;

               Context := Scope (Context);
            end loop;
         end Check_Mode_Restriction_In_Enclosing_Context;

         ----------------------------------------
         -- Check_Mode_Restriction_In_Function --
         ----------------------------------------

         procedure Check_Mode_Restriction_In_Function (Mode : Node_Id) is
         begin
            if Ekind_In (Spec_Id, E_Function, E_Generic_Function) then
               SPARK_Msg_N
                 ("global mode & is not applicable to functions", Mode);
            end if;
         end Check_Mode_Restriction_In_Function;

         --  Local variables

         Assoc : Node_Id;
         Item  : Node_Id;
         Mode  : Node_Id;

      --  Start of processing for Analyze_Global_List

      begin
         if Nkind (List) = N_Null then
            Set_Analyzed (List);

         --  Single global item declaration

         elsif Nkind_In (List, N_Expanded_Name,
                               N_Identifier,
                               N_Selected_Component)
         then
            Analyze_Global_Item (List, Global_Mode);

         --  Simple global list or moded global list declaration

         elsif Nkind (List) = N_Aggregate then
            Set_Analyzed (List);

            --  The declaration of a simple global list appear as a collection
            --  of expressions.

            if Present (Expressions (List)) then
               if Present (Component_Associations (List)) then
                  SPARK_Msg_N
                    ("cannot mix moded and non-moded global lists", List);
               end if;

               Item := First (Expressions (List));
               while Present (Item) loop
                  Analyze_Global_Item (Item, Global_Mode);
                  Next (Item);
               end loop;

            --  The declaration of a moded global list appears as a collection
            --  of component associations where individual choices denote
            --  modes.

            elsif Present (Component_Associations (List)) then
               if Present (Expressions (List)) then
                  SPARK_Msg_N
                    ("cannot mix moded and non-moded global lists", List);
               end if;

               Assoc := First (Component_Associations (List));
               while Present (Assoc) loop
                  Mode := First (Choices (Assoc));

                  if Nkind (Mode) = N_Identifier then
                     if Chars (Mode) = Name_In_Out then
                        Check_Duplicate_Mode (Mode, In_Out_Seen);
                        Check_Mode_Restriction_In_Function (Mode);

                     elsif Chars (Mode) = Name_Input then
                        Check_Duplicate_Mode (Mode, Input_Seen);

                     elsif Chars (Mode) = Name_Output then
                        Check_Duplicate_Mode (Mode, Output_Seen);
                        Check_Mode_Restriction_In_Function (Mode);

                     elsif Chars (Mode) = Name_Proof_In then
                        Check_Duplicate_Mode (Mode, Proof_Seen);

                     else
                        SPARK_Msg_N ("invalid mode selector", Mode);
                     end if;

                  else
                     SPARK_Msg_N ("invalid mode selector", Mode);
                  end if;

                  --  Items in a moded list appear as a collection of
                  --  expressions. Reuse the existing machinery to analyze
                  --  them.

                  Analyze_Global_List
                    (List        => Expression (Assoc),
                     Global_Mode => Chars (Mode));

                  Next (Assoc);
               end loop;

            --  Invalid tree

            else
               raise Program_Error;
            end if;

         --  Any other attempt to declare a global item is illegal. This is a
         --  syntax error, always report.

         else
            Error_Msg_N ("malformed global list", List);
         end if;
      end Analyze_Global_List;

      --  Local variables

      Items : constant Node_Id := Expression (Get_Argument (N, Spec_Id));

      Restore_Scope : Boolean := False;

   --  Start of processing for Analyze_Global_In_Decl_Part

   begin
      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      --  There is nothing to be done for a null global list

      if Nkind (Items) = N_Null then
         Set_Analyzed (Items);

      --  Analyze the various forms of global lists and items. Note that some
      --  of these may be malformed in which case the analysis emits error
      --  messages.

      else
         --  When pragma [Refined_]Global appears on a single concurrent type,
         --  it is relocated to the anonymous object.

         if Is_Single_Concurrent_Object (Spec_Id) then
            null;

         --  Ensure that the formal parameters are visible when processing an
         --  item. This falls out of the general rule of aspects pertaining to
         --  subprogram declarations.

         elsif not In_Open_Scopes (Spec_Id) then
            Restore_Scope := True;
            Push_Scope (Spec_Id);

            if Ekind (Spec_Id) = E_Task_Type then
               if Has_Discriminants (Spec_Id) then
                  Install_Discriminants (Spec_Id);
               end if;

            elsif Is_Generic_Subprogram (Spec_Id) then
               Install_Generic_Formals (Spec_Id);

            else
               Install_Formals (Spec_Id);
            end if;
         end if;

         Analyze_Global_List (Items);

         if Restore_Scope then
            End_Scope;
         end if;
      end if;

      --  Ensure that a state and a corresponding constituent do not appear
      --  together in pragma [Refined_]Global.

      Check_State_And_Constituent_Use
        (States   => States_Seen,
         Constits => Constits_Seen,
         Context  => N);

      Set_Is_Analyzed_Pragma (N);
   end Analyze_Global_In_Decl_Part;

   --------------------------------------------
   -- Analyze_Initial_Condition_In_Decl_Part --
   --------------------------------------------

   --  WARNING: This routine manages Ghost regions. Return statements must be
   --  replaced by gotos which jump to the end of the routine and restore the
   --  Ghost mode.

   procedure Analyze_Initial_Condition_In_Decl_Part (N : Node_Id) is
      Pack_Decl : constant Node_Id   := Find_Related_Package_Or_Body (N);
      Pack_Id   : constant Entity_Id := Defining_Entity (Pack_Decl);
      Expr      : constant Node_Id   := Expression (Get_Argument (N, Pack_Id));

      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
      --  Save the Ghost-related attributes to restore on exit

   begin
      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      --  Set the Ghost mode in effect from the pragma. Due to the delayed
      --  analysis of the pragma, the Ghost mode at point of declaration and
      --  point of analysis may not necessarily be the same. Use the mode in
      --  effect at the point of declaration.

      Set_Ghost_Mode (N);

      --  The expression is preanalyzed because it has not been moved to its
      --  final place yet. A direct analysis may generate side effects and this
      --  is not desired at this point.

      Preanalyze_Assert_Expression (Expr, Standard_Boolean);
      Set_Is_Analyzed_Pragma (N);

      Restore_Ghost_Region (Saved_GM, Saved_IGR);
   end Analyze_Initial_Condition_In_Decl_Part;

   --------------------------------------
   -- Analyze_Initializes_In_Decl_Part --
   --------------------------------------

   procedure Analyze_Initializes_In_Decl_Part (N : Node_Id) is
      Pack_Decl : constant Node_Id   := Find_Related_Package_Or_Body (N);
      Pack_Id   : constant Entity_Id := Defining_Entity (Pack_Decl);

      Constits_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all constituents processed so far.
      --  It aids in detecting illegal usage of a state and a corresponding
      --  constituent in pragma Initializes.

      Items_Seen : Elist_Id := No_Elist;
      --  A list of all initialization items processed so far. This list is
      --  used to detect duplicate items.

      States_And_Objs : Elist_Id := No_Elist;
      --  A list of all abstract states and objects declared in the visible
      --  declarations of the related package. This list is used to detect the
      --  legality of initialization items.

      States_Seen : Elist_Id := No_Elist;
      --  A list containing the entities of all states processed so far. It
      --  helps in detecting illegal usage of a state and a corresponding
      --  constituent in pragma Initializes.

      procedure Analyze_Initialization_Item (Item : Node_Id);
      --  Verify the legality of a single initialization item

      procedure Analyze_Initialization_Item_With_Inputs (Item : Node_Id);
      --  Verify the legality of a single initialization item followed by a
      --  list of input items.

      procedure Collect_States_And_Objects;
      --  Inspect the visible declarations of the related package and gather
      --  the entities of all abstract states and objects in States_And_Objs.

      ---------------------------------
      -- Analyze_Initialization_Item --
      ---------------------------------

      procedure Analyze_Initialization_Item (Item : Node_Id) is
         Item_Id : Entity_Id;

      begin
         Analyze       (Item);
         Resolve_State (Item);

         if Is_Entity_Name (Item) then
            Item_Id := Entity_Of (Item);

            if Present (Item_Id)
              and then Ekind_In (Item_Id, E_Abstract_State,
                                          E_Constant,
                                          E_Variable)
            then
               --  When the initialization item is undefined, it appears as
               --  Any_Id. Do not continue with the analysis of the item.

               if Item_Id = Any_Id then
                  null;

               --  The state or variable must be declared in the visible
               --  declarations of the package (SPARK RM 7.1.5(7)).

               elsif not Contains (States_And_Objs, Item_Id) then
                  Error_Msg_Name_1 := Chars (Pack_Id);
                  SPARK_Msg_NE
                    ("initialization item & must appear in the visible "
                     & "declarations of package %", Item, Item_Id);

               --  Detect a duplicate use of the same initialization item
               --  (SPARK RM 7.1.5(5)).

               elsif Contains (Items_Seen, Item_Id) then
                  SPARK_Msg_N ("duplicate initialization item", Item);

               --  The item is legal, add it to the list of processed states
               --  and variables.

               else
                  Append_New_Elmt (Item_Id, Items_Seen);

                  if Ekind (Item_Id) = E_Abstract_State then
                     Append_New_Elmt (Item_Id, States_Seen);
                  end if;

                  if Present (Encapsulating_State (Item_Id)) then
                     Append_New_Elmt (Item_Id, Constits_Seen);
                  end if;
               end if;

            --  The item references something that is not a state or object
            --  (SPARK RM 7.1.5(3)).

            else
               SPARK_Msg_N
                 ("initialization item must denote object or state", Item);
            end if;

         --  Some form of illegal construct masquerading as a name
         --  (SPARK RM 7.1.5(3)). This is a syntax error, always report.

         else
            Error_Msg_N
              ("initialization item must denote object or state", Item);
         end if;
      end Analyze_Initialization_Item;

      ---------------------------------------------
      -- Analyze_Initialization_Item_With_Inputs --
      ---------------------------------------------

      procedure Analyze_Initialization_Item_With_Inputs (Item : Node_Id) is
         Inputs_Seen : Elist_Id := No_Elist;
         --  A list of all inputs processed so far. This list is used to detect
         --  duplicate uses of an input.

         Non_Null_Seen : Boolean := False;
         Null_Seen     : Boolean := False;
         --  Flags used to check the legality of an input list

         procedure Analyze_Input_Item (Input : Node_Id);
         --  Verify the legality of a single input item

         ------------------------
         -- Analyze_Input_Item --
         ------------------------

         procedure Analyze_Input_Item (Input : Node_Id) is
            Input_Id : Entity_Id;

         begin
            --  Null input list

            if Nkind (Input) = N_Null then
               if Null_Seen then
                  SPARK_Msg_N
                    ("multiple null initializations not allowed", Item);

               elsif Non_Null_Seen then
                  SPARK_Msg_N
                    ("cannot mix null and non-null initialization item", Item);
               else
                  Null_Seen := True;
               end if;

            --  Input item

            else
               Non_Null_Seen := True;

               if Null_Seen then
                  SPARK_Msg_N
                    ("cannot mix null and non-null initialization item", Item);
               end if;

               Analyze       (Input);
               Resolve_State (Input);

               if Is_Entity_Name (Input) then
                  Input_Id := Entity_Of (Input);

                  if Present (Input_Id)
                    and then Ekind_In (Input_Id, E_Abstract_State,
                                                 E_Constant,
                                                 E_Generic_In_Out_Parameter,
                                                 E_Generic_In_Parameter,
                                                 E_In_Parameter,
                                                 E_In_Out_Parameter,
                                                 E_Out_Parameter,
                                                 E_Protected_Type,
                                                 E_Task_Type,
                                                 E_Variable)
                  then
                     --  The input cannot denote states or objects declared
                     --  within the related package (SPARK RM 7.1.5(4)).

                     if Within_Scope (Input_Id, Current_Scope) then

                        --  Do not consider generic formal parameters or their
                        --  respective mappings to generic formals. Even though
                        --  the formals appear within the scope of the package,
                        --  it is allowed for an initialization item to depend
                        --  on an input item.

                        if Ekind_In (Input_Id, E_Generic_In_Out_Parameter,
                                               E_Generic_In_Parameter)
                        then
                           null;

                        elsif Ekind_In (Input_Id, E_Constant, E_Variable)
                          and then Present (Corresponding_Generic_Association
                                     (Declaration_Node (Input_Id)))
                        then
                           null;

                        else
                           Error_Msg_Name_1 := Chars (Pack_Id);
                           SPARK_Msg_NE
                             ("input item & cannot denote a visible object or "
                              & "state of package %", Input, Input_Id);
                           return;
                        end if;
                     end if;

                     --  Detect a duplicate use of the same input item
                     --  (SPARK RM 7.1.5(5)).

                     if Contains (Inputs_Seen, Input_Id) then
                        SPARK_Msg_N ("duplicate input item", Input);
                        return;
                     end if;

                     --  At this point it is known that the input is legal. Add
                     --  it to the list of processed inputs.

                     Append_New_Elmt (Input_Id, Inputs_Seen);

                     if Ekind (Input_Id) = E_Abstract_State then
                        Append_New_Elmt (Input_Id, States_Seen);
                     end if;

                     if Ekind_In (Input_Id, E_Abstract_State,
                                            E_Constant,
                                            E_Variable)
                       and then Present (Encapsulating_State (Input_Id))
                     then
                        Append_New_Elmt (Input_Id, Constits_Seen);
                     end if;

                  --  The input references something that is not a state or an
                  --  object (SPARK RM 7.1.5(3)).

                  else
                     SPARK_Msg_N
                       ("input item must denote object or state", Input);
                  end if;

               --  Some form of illegal construct masquerading as a name
               --  (SPARK RM 7.1.5(3)). This is a syntax error, always report.

               else
                  Error_Msg_N
                    ("input item must denote object or state", Input);
               end if;
            end if;
         end Analyze_Input_Item;

         --  Local variables

         Inputs : constant Node_Id := Expression (Item);
         Elmt   : Node_Id;
         Input  : Node_Id;

         Name_Seen : Boolean := False;
         --  A flag used to detect multiple item names

      --  Start of processing for Analyze_Initialization_Item_With_Inputs

      begin
         --  Inspect the name of an item with inputs

         Elmt := First (Choices (Item));
         while Present (Elmt) loop
            if Name_Seen then
               SPARK_Msg_N ("only one item allowed in initialization", Elmt);
            else
               Name_Seen := True;
               Analyze_Initialization_Item (Elmt);
            end if;

            Next (Elmt);
         end loop;

         --  Multiple input items appear as an aggregate

         if Nkind (Inputs) = N_Aggregate then
            if Present (Expressions (Inputs)) then
               Input := First (Expressions (Inputs));
               while Present (Input) loop
                  Analyze_Input_Item (Input);
                  Next (Input);
               end loop;
            end if;

            if Present (Component_Associations (Inputs)) then
               SPARK_Msg_N
                 ("inputs must appear in named association form", Inputs);
            end if;

         --  Single input item

         else
            Analyze_Input_Item (Inputs);
         end if;
      end Analyze_Initialization_Item_With_Inputs;

      --------------------------------
      -- Collect_States_And_Objects --
      --------------------------------

      procedure Collect_States_And_Objects is
         Pack_Spec : constant Node_Id := Specification (Pack_Decl);
         Decl      : Node_Id;

      begin
         --  Collect the abstract states defined in the package (if any)

         if Present (Abstract_States (Pack_Id)) then
            States_And_Objs := New_Copy_Elist (Abstract_States (Pack_Id));
         end if;

         --  Collect all objects that appear in the visible declarations of the
         --  related package.

         if Present (Visible_Declarations (Pack_Spec)) then
            Decl := First (Visible_Declarations (Pack_Spec));
            while Present (Decl) loop
               if Comes_From_Source (Decl)
                 and then Nkind_In (Decl, N_Object_Declaration,
                                          N_Object_Renaming_Declaration)
               then
                  Append_New_Elmt (Defining_Entity (Decl), States_And_Objs);

               elsif Is_Single_Concurrent_Type_Declaration (Decl) then
                  Append_New_Elmt
                    (Anonymous_Object (Defining_Entity (Decl)),
                     States_And_Objs);
               end if;

               Next (Decl);
            end loop;
         end if;
      end Collect_States_And_Objects;

      --  Local variables

      Inits : constant Node_Id := Expression (Get_Argument (N, Pack_Id));
      Init  : Node_Id;

   --  Start of processing for Analyze_Initializes_In_Decl_Part

   begin
      --  Do not analyze the pragma multiple times

      if Is_Analyzed_Pragma (N) then
         return;
      end if;

      --  Nothing to do when the initialization list is empty

      if Nkind (Inits) = N_Null then
         return;
      end if;

      --  Single and multiple initialization clauses appear as an aggregate. If
      --  this is not the case, then either the parser or the analysis of the
      --  pragma failed to produce an aggregate.

      pragma Assert (Nkind (Inits) = N_Aggregate);

      --  Initialize the various lists used during analysis

      Collect_States_And_Objects;

      if Present (Expressions (Inits)) then
         Init := First (Expressions (Inits));
         while Present (Init) loop
            Analyze_Initialization_Item (Init);
            Next (Init);
         end loop;
      end if;

      if Present (Component_Associations (Inits)) then
         Init := First (Component_Associations (Inits));
         while Present (Init) loop
            Analyze_Initialization_Item_With_Inputs (Init);
            Next (Init);
         end loop;
      end if;

      --  Ensure that a state and a corresponding constituent do not appear
      --  together in pragma Initializes.

      Check_State_And_Constituent_Use
        (States   => States_Seen,
         Constits => Constits_Seen,
         Context  => N);

      Set_Is_Analyzed_Pragma (N);
   end Analyze_Initializes_In_Decl_Part;

   ---------------------
   -- Analyze_Part_Of --
   ---------------------

   procedure Analyze_Part_Of
     (Indic    : Node_Id;
      Item_Id  : Entity_Id;
      Encap    : Node_Id;
      Encap_Id : out Entity_Id;
      Legal    : out Boolean)
   is
      procedure Check_Part_Of_Abstract_State;
      pragma Inline (Check_Part_Of_Abstract_State);
      --  Verify the legality of indicator Part_Of when the encapsulator is an
      --  abstract state.

      procedure Check_Part_Of_Concurrent_Type;
      pragma Inline (Check_Part_Of_Concurrent_Type);
      --  Verify the legality of indicator Part_Of when the encapsulator is a
      --  single concurrent type.

      ----------------------------------
      -- Check_Part_Of_Abstract_State --
      ----------------------------------

      procedure Check_Part_Of_Abstract_State is
         Pack_Id     : Entity_Id;
         Placement   : State_Space_Kind;
         Parent_Unit : Entity_Id;

      begin
         --  Determine where the object, package instantiation or state lives
         --  with respect to the enclosing packages or package bodies.

         Find_Placement_In_State_Space
           (Item_Id   => Item_Id,
            Placement => Placement,
            Pack_Id   => Pack_Id);

         --  The item appears in a non-package construct with a declarative
         --  part (subprogram, block, etc). As such, the item is not allowed
         --  to be a part of an encapsulating state because the item is not
         --  visible.

         if Placement = Not_In_Package then
            SPARK_Msg_N
              ("indicator Part_Of cannot appear in this context "
               & "(SPARK RM 7.2.6(5))", Indic);

            Error_Msg_Name_1 := Chars (Scope (Encap_Id));
            SPARK_Msg_NE
              ("\& is not part of the hidden state of package %",
               Indic, Item_Id);
            return;

         --  The item appears in the visible state space of some package. In
         --  general this scenario does not warrant Part_Of except when the
         --  package is a nongeneric private child unit and the encapsulating
         --  state is declared in a parent unit or a public descendant of that
         --  parent unit.

         elsif Placement = Visible_State_Space then
            if Is_Child_Unit (Pack_Id)
              and then not Is_Generic_Unit (Pack_Id)
              and then Is_Private_Descendant (Pack_Id)
            then
               --  A variable or state abstraction which is part of the visible
               --  state of a nongeneric private child unit or its public
               --  descendants must have its Part_Of indicator specified. The
               --  Part_Of indicator must denote a state declared by either the
               --  parent unit of the private unit or by a public descendant of
               --  that parent unit.

               --  Find the nearest private ancestor (which can be the current
               --  unit itself).

               Parent_Unit := Pack_Id;
               while Present (Parent_Unit) loop
                  exit when
                    Private_Present
                      (Parent (Unit_Declaration_Node (Parent_Unit)));
                  Parent_Unit := Scope (Parent_Unit);
               end loop;

               Parent_Unit := Scope (Parent_Unit);

               if not Is_Child_Or_Sibling (Pack_Id, Scope (Encap_Id)) then
                  SPARK_Msg_NE
                    ("indicator Part_Of must denote abstract state of & or of "
                     & "its public descendant (SPARK RM 7.2.6(3))",
                     Indic, Parent_Unit);
                  return;

               elsif Scope (Encap_Id) = Parent_Unit
                 or else
                   (Is_Ancestor_Package (Parent_Unit, Scope (Encap_Id))
                     and then not Is_Private_Descendant (Scope (Encap_Id)))
               then
                  null;

               else
                  SPARK_Msg_NE
                    ("indicator Part_Of must denote abstract state of & or of "
                     & "its public descendant (SPARK RM 7.2.6(3))",
                     Indic, Parent_Unit);
                  return;
               end if;

            --  Indicator Part_Of is not needed when the related package is
            --  not a nongeneric private child unit or a public descendant
            --  thereof.

            else
               SPARK_Msg_N
                 ("indicator Part_Of cannot appear in this context "
                  & "(SPARK RM 7.2.6(5))", Indic);

               Error_Msg_Name_1 := Chars (Pack_Id);
               SPARK_Msg_NE
                 ("\& is declared in the visible part of package %",
                  Indic, Item_Id);
               return;
            end if;

         --  When the item appears in the private state space of a package, the
         --  encapsulating state must be declared in the same package.

         elsif Placement = Private_State_Space then
            if Scope (Encap_Id) /= Pack_Id then
               SPARK_Msg_NE
                 ("indicator Part_Of must denote an abstract state of "
                  & "package & (SPARK RM 7.2.6(2))", Indic, Pack_Id);

               Error_Msg_Name_1 := Chars (Pack_Id);
               SPARK_Msg_NE
                 ("\& is declared in the private part of package %",
                  Indic, Item_Id);
               return;
            end if;

         --  Items declared in the body state space of a package do not need
         --  Part_Of indicators as the refinement has already been seen.

         else
            SPARK_Msg_N
              ("indicator Part_Of cannot appear in this context "
               & "(SPARK RM 7.2.6(5))", Indic);

            if Scope (Encap_Id) = Pack_Id then
               Error_Msg_Name_1 := Chars (Pack_Id);
               SPARK_Msg_NE
                 ("\& is declared in the body of package %", Indic, Item_Id);
            end if;

            return;
         end if;

         --  At this point it is known that the Part_Of indicator is legal

         Legal := True;
      end Check_Part_Of_Abstract_State;

      -----------------------------------
      -- Check_Part_Of_Concurrent_Type --
      -----------------------------------

      procedure Check_Part_Of_Concurrent_Type is
         function In_Proper_Order
           (First  : Node_Id;
            Second : Node_Id) return Boolean;
         pragma Inline (In_Proper_Order);
         --  Determine whether node First precedes node Second

         procedure Placement_Error;
         pragma Inline (Placement_Error);
         --  Emit an error concerning the illegal placement of the item with
         --  respect to the single concurrent type.

         ---------------------
         -- In_Proper_Order --
         ---------------------

         function In_Proper_Order
           (First  : Node_Id;
            Second : Node_Id) return Boolean
         is
            N : Node_Id;

         begin
            if List_Containing (First) = List_Containing (Second) then
               N := First;
               while Present (N) loop
                  if N = Second then
                     return True;
                  end if;

                  Next (N);
               end loop;
            end if;

            return False;
         end In_Proper_Order;

         ---------------------
         -- Placement_Error --
         ---------------------

         procedure Placement_Error is
         begin
            SPARK_Msg_N
              ("indicator Part_Of must denote a previously declared single "
               & "protected type or single task type", Encap);
         end Placement_Error;

         --  Local variables

         Conc_Typ      : constant Entity_Id := Etype (Encap_Id);
         Encap_Decl    : constant Node_Id   := Declaration_Node (Encap_Id);
         Encap_Context : constant Node_Id   := Parent (Encap_Decl);

         Item_Context : Node_Id;
         Item_Decl    : Node_Id;
         Prv_Decls    : List_Id;
         Vis_Decls    : List_Id;

      --  Start of processing for Check_Part_Of_Concurrent_Type

      begin
         --  Only abstract states and variables can act as constituents of an
         --  encapsulating single concurrent type.

         if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
            null;

         --  The constituent is a constant

         elsif Ekind (Item_Id) = E_Constant then
            Error_Msg_Name_1 := Chars (Encap_Id);
            SPARK_Msg_NE
              (Fix_Msg (Conc_Typ, "constant & cannot act as constituent of "
               & "single protected type %"), Indic, Item_Id);
            return;

         --  The constituent is a package instantiation

         else
            Error_Msg_Name_1 := Chars (Encap_Id);
            SPARK_Msg_NE
              (Fix_Msg (Conc_Typ, "package instantiation & cannot act as "
               & "constituent of single protected type %"), Indic, Item_Id);
            return;
         end if;

         --  When the item denotes an abstract state of a nested package, use
         --  the declaration of the package to detect proper placement.

         --    package Pack is
         --       task T;
         --       package Nested
         --         with Abstract_State => (State with Part_Of => T)

         if Ekind (Item_Id) = E_Abstract_State then
            Item_Decl := Unit_Declaration_Node (Scope (Item_Id));
         else
            Item_Decl := Declaration_Node (Item_Id);
         end if;

         Item_Context := Parent (Item_Decl);

         --  The item and the single concurrent type must appear in the same
         --  declarative region, with the item following the declaration of
         --  the single concurrent type (SPARK RM 9(3)).

         if Item_Context = Encap_Context then
            if Nkind_In (Item_Context, N_Package_Specification,
                                       N_Protected_Definition,
                                       N_Task_Definition)
            then
               Prv_Decls := Private_Declarations (Item_Context);
               Vis_Decls := Visible_Declarations (Item_Context);

               --  The placement is OK when the single concurrent type appears
               --  within the visible declarations and the item in the private
               --  declarations.
               --
               --    package Pack is
               --       protected PO ...
               --    private
               --       Constit : ... with Part_Of => PO;
               --    end Pack;

               if List_Containing (Encap_Decl) = Vis_Decls
                 and then List_Containing (Item_Decl) = Prv_Decls
               then
                  null;

               --  The placement is illegal when the item appears within the
               --  visible declarations and the single concurrent type is in
               --  the private declarations.
               --
               --    package Pack is
               --       Constit : ... with Part_Of => PO;
               --    private
               --       protected PO ...
               --    end Pack;

               elsif List_Containing (Item_Decl) = Vis_Decls
                 and then List_Containing (Encap_Decl) = Prv_Decls
               then
                  Placement_Error;
                  return;

               --  Otherwise both the item and the single concurrent type are
               --  in the same list. Ensure that the declaration of the single
               --  concurrent type precedes that of the item.

               elsif not In_Proper_Order
                           (First  => Encap_Decl,
                            Second => Item_Decl)
               then
                  Placement_Error;
                  return;
               end if;

            --  Otherwise both the item and the single concurrent type are
            --  in the same list. Ensure that the declaration of the single
            --  concurrent type precedes that of the item.

            elsif not In_Proper_Order
                        (First  => Encap_Decl,
                         Second => Item_Decl)
            then
               Placement_Error;
               return;
            end if;

         --  Otherwise the item and the single concurrent type reside within
         --  unrelated regions.

         else
            Error_Msg_Name_1 := Chars (Encap_Id);
            SPARK_Msg_NE
              (Fix_Msg (Conc_Typ, "constituent & must be declared "
               & "immediately within the same region as single protected "
               & "type %"), Indic, Item_Id);
            return;
         end if;

         --  At this point it is known that the Part_Of indicator is legal

         Legal := True;
      end Check_Part_Of_Concurrent_Type;

   --  Start of processing for Analyze_Part_Of

   begin
      --  Assume that the indicator is illegal

      Encap_Id := Empty;
      Legal    := False;

      if Nkind_In (Encap, N_Expanded_Name,
                          N_Identifier,
                          N_Selected_Component)
      then
         Analyze       (Encap);
         Resolve_State (Encap);

         Encap_Id := Entity (Encap);

         --  The encapsulator is an abstract state

         if Ekind (Encap_Id) = E_Abstract_State then
            null;

         --  The encapsulator is a single concurrent type (SPARK RM 9.3)

         elsif Is_Single_Concurrent_Object (Encap_Id) then
            null;

         --  Otherwise the encapsulator is not a legal choice

         else
            SPARK_Msg_N
              ("indicator Part_Of must denote abstract state, single "
               & "protected type or single task type", Encap);
            return;
         end if;

      --  This is a syntax error, always report

      else
         Error_Msg_N
           ("indicator Part_Of must denote abstract state, single protected "
            & "type or single task type", Encap);
         return;
      end if;

      --  Catch a case where indicator Part_Of denotes the abstract view of a
      --  variable which appears as an abstract state (SPARK RM 10.1.2 2).

      if From_Limited_With (Encap_Id)
        and then Present (Non_Limited_View (Encap_Id))
        and then Ekind (Non_Limited_View (Encap_Id)) = E_Variable
      then
         SPARK_Msg_N ("indicator Part_Of must denote abstract state", Encap);
         SPARK_Msg_N ("\& denotes abstract view of object", Encap);
         return;
      end if;

      --  The encapsulator is an abstract state

      if Ekind (Encap_Id) = E_Abstract_State then
         Check_Part_Of_Abstract_State;

      --  The encapsulator is a single concurrent type

      else
         Check_Part_Of_Concurrent_Type;
      end if;
   end Analyze_Part_Of;

   ----------------------------------
   -- Analyze_Part_Of_In_Decl_Part --
   ----------------------------------

   procedure Analyze_Part_Of_In_Decl_Part
     (N         : Node_Id;
      Freeze_Id : Entity_Id := Empty)
   is
      Encap    : constant Node_Id   :=
                   Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
      Errors   : constant Nat       := Serious_Errors_Detected;
      Var_Decl : constant Node_Id   := Find_Related_Context (N);
      Var_Id   : constant Entity_Id := Defining_Entity (Var_Decl);
      Constits : Elist_Id;
      Encap_Id : Entity_Id;
      Legal    : Boolean;

   begin
      --  Detect any discrepancies between the placement of the variable with
      --  respect to general state space and the encapsulating state or single
      --  concurrent type.

      Analyze_Part_Of
        (Indic    => N,
         Item_Id  => Var_Id,
         Encap    => Encap,
         Encap_Id => Encap_Id,
         Legal    => Legal);

      --  The Part_Of indicator turns the variable into a constituent of the
      --  encapsulating state or single concurrent type.

      if Legal then
         pragma Assert (Present (Encap_Id));
         Constits := Part_Of_Constituents (Encap_Id);

         if No (Constits) then
            Constits := New_Elmt_List;
            Set_Part_Of_Constituents (Encap_Id, Constits);
         end if;

         Append_Elmt (Var_Id, Constits);
         Set_Encapsulating_State (Var_Id, Encap_Id);

         --  A Part_Of constituent partially refines an abstract state. This
         --  property does not apply to protected or task units.

         if Ekind (Encap_Id) = E_Abstract_State then
            Set_Has_Partial_Visible_Refinement (Encap_Id);
         end if;
      end if;

      --  Emit a clarification message when the encapsulator is undefined,
      --  possibly due to contract freezing.

      if Errors /= Serious_Errors_Detected
        and then Present (Freeze_Id)
        and then Has_Undefined_Reference (Encap)
      then
         Contract_Freeze_Error (Var_Id, Freeze_Id);
      end if;
   end Analyze_Part_Of_In_Decl_Part;

   --------------------
   -- Analyze_Pragma --
   --------------------

   procedure Analyze_Pragma (N : Node_Id) is
      Loc : constant Source_Ptr := Sloc (N);

      Pname : Name_Id := Pragma_Name (N);
      --  Name of the source pragma, or name of the corresponding aspect for
      --  pragmas which originate in a source aspect. In the latter case, the
      --  name may be different from the pragma name.

      Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname);

      Pragma_Exit : exception;
      --  This exception is used to exit pragma processing completely. It
      --  is used when an error is detected, and no further processing is
      --  required. It is also used if an earlier error has left the tree in
      --  a state where the pragma should not be processed.

      Arg_Count : Nat;
      --  Number of pragma argument associations

      Arg1 : Node_Id;
      Arg2 : Node_Id;
      Arg3 : Node_Id;
      Arg4 : Node_Id;
      --  First four pragma arguments (pragma argument association nodes, or
      --  Empty if the corresponding argument does not exist).

      type Name_List is array (Natural range <>) of Name_Id;
      type Args_List is array (Natural range <>) of Node_Id;
      --  Types used for arguments to Check_Arg_Order and Gather_Associations

      -----------------------
      -- Local Subprograms --
      -----------------------

      function Acc_First (N : Node_Id) return Node_Id;
      --  Helper function to iterate over arguments given to OpenAcc pragmas

      function Acc_Next (N : Node_Id) return Node_Id;
      --  Helper function to iterate over arguments given to OpenAcc pragmas

      procedure Acquire_Warning_Match_String (Arg : Node_Id);
      --  Used by pragma Warnings (Off, string), and Warn_As_Error (string) to
      --  get the given string argument, and place it in Name_Buffer, adding
      --  leading and trailing asterisks if they are not already present. The
      --  caller has already checked that Arg is a static string expression.

      procedure Ada_2005_Pragma;
      --  Called for pragmas defined in Ada 2005, that are not in Ada 95. In
      --  Ada 95 mode, these are implementation defined pragmas, so should be
      --  caught by the No_Implementation_Pragmas restriction.

      procedure Ada_2012_Pragma;
      --  Called for pragmas defined in Ada 2012, that are not in Ada 95 or 05.
      --  In Ada 95 or 05 mode, these are implementation defined pragmas, so
      --  should be caught by the No_Implementation_Pragmas restriction.

      procedure Analyze_Depends_Global
        (Spec_Id   : out Entity_Id;
         Subp_Decl : out Node_Id;
         Legal     : out Boolean);
      --  Subsidiary to the analysis of pragmas Depends and Global. Verify the
      --  legality of the placement and related context of the pragma. Spec_Id
      --  is the entity of the related subprogram. Subp_Decl is the declaration
      --  of the related subprogram. Sets flag Legal when the pragma is legal.

      procedure Analyze_If_Present (Id : Pragma_Id);
      --  Inspect the remainder of the list containing pragma N and look for
      --  a pragma that matches Id. If found, analyze the pragma.

      procedure Analyze_Pre_Post_Condition;
      --  Subsidiary to the analysis of pragmas Precondition and Postcondition

      procedure Analyze_Refined_Depends_Global_Post
        (Spec_Id : out Entity_Id;
         Body_Id : out Entity_Id;
         Legal   : out Boolean);
      --  Subsidiary routine to the analysis of body pragmas Refined_Depends,
      --  Refined_Global and Refined_Post. Verify the legality of the placement
      --  and related context of the pragma. Spec_Id is the entity of the
      --  related subprogram. Body_Id is the entity of the subprogram body.
      --  Flag Legal is set when the pragma is legal.

      procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False);
      --  Perform full analysis of pragma Unmodified and the write aspect of
      --  pragma Unused. Flag Is_Unused should be set when verifying the
      --  semantics of pragma Unused.

      procedure Analyze_Unreferenced_Or_Unused (Is_Unused : Boolean := False);
      --  Perform full analysis of pragma Unreferenced and the read aspect of
      --  pragma Unused. Flag Is_Unused should be set when verifying the
      --  semantics of pragma Unused.

      procedure Check_Ada_83_Warning;
      --  Issues a warning message for the current pragma if operating in Ada
      --  83 mode (used for language pragmas that are not a standard part of
      --  Ada 83). This procedure does not raise Pragma_Exit. Also notes use
      --  of 95 pragma.

      procedure Check_Arg_Count (Required : Nat);
      --  Check argument count for pragma is equal to given parameter. If not,
      --  then issue an error message and raise Pragma_Exit.

      --  Note: all routines whose name is Check_Arg_Is_xxx take an argument
      --  Arg which can either be a pragma argument association, in which case
      --  the check is applied to the expression of the association or an
      --  expression directly.

      procedure Check_Arg_Is_External_Name (Arg : Node_Id);
      --  Check that an argument has the right form for an EXTERNAL_NAME
      --  parameter of an extended import/export pragma. The rule is that the
      --  name must be an identifier or string literal (in Ada 83 mode) or a
      --  static string expression (in Ada 95 mode).

      procedure Check_Arg_Is_Identifier (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is an
      --  identifier. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Integer_Literal (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is an integer
      --  literal. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Library_Level_Local_Name (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it has the proper
      --  syntactic form for a local name and meets the semantic requirements
      --  for a local name. The local name is analyzed as part of the
      --  processing for this call. In addition, the local name is required
      --  to represent an entity at the library level.

      procedure Check_Arg_Is_Local_Name (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it has the proper
      --  syntactic form for a local name and meets the semantic requirements
      --  for a local name. The local name is analyzed as part of the
      --  processing for this call.

      procedure Check_Arg_Is_Locking_Policy (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is a valid
      --  locking policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Partition_Elaboration_Policy (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is a valid
      --  elaboration policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2             : Name_Id);
      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2, N3         : Name_Id);
      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2, N3, N4     : Name_Id);
      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2, N3, N4, N5 : Name_Id);
      --  Check the specified argument Arg to make sure that it is an
      --  identifier whose name matches either N1 or N2 (or N3, N4, N5 if
      --  present). If not then give error and raise Pragma_Exit.

      procedure Check_Arg_Is_Queuing_Policy (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is a valid
      --  queuing policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Is_OK_Static_Expression
        (Arg : Node_Id;
         Typ : Entity_Id := Empty);
      --  Check the specified argument Arg to make sure that it is a static
      --  expression of the given type (i.e. it will be analyzed and resolved
      --  using this type, which can be any valid argument to Resolve, e.g.
      --  Any_Integer is OK). If not, given error and raise Pragma_Exit. If
      --  Typ is left Empty, then any static expression is allowed. Includes
      --  checking that the argument does not raise Constraint_Error.

      procedure Check_Arg_Is_Task_Dispatching_Policy (Arg : Node_Id);
      --  Check the specified argument Arg to make sure that it is a valid task
      --  dispatching policy name. If not give error and raise Pragma_Exit.

      procedure Check_Arg_Order (Names : Name_List);
      --  Checks for an instance of two arguments with identifiers for the
      --  current pragma which are not in the sequence indicated by Names,
      --  and if so, generates a fatal message about bad order of arguments.

      procedure Check_At_Least_N_Arguments (N : Nat);
      --  Check there are at least N arguments present

      procedure Check_At_Most_N_Arguments (N : Nat);
      --  Check there are no more than N arguments present

      procedure Check_Component
        (Comp            : Node_Id;
         UU_Typ          : Entity_Id;
         In_Variant_Part : Boolean := False);
      --  Examine an Unchecked_Union component for correct use of per-object
      --  constrained subtypes, and for restrictions on finalizable components.
      --  UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part
      --  should be set when Comp comes from a record variant.

      procedure Check_Duplicate_Pragma (E : Entity_Id);
      --  Check if a rep item of the same name as the current pragma is already
      --  chained as a rep pragma to the given entity. If so give a message
      --  about the duplicate, and then raise Pragma_Exit so does not return.
      --  Note that if E is a type, then this routine avoids flagging a pragma
      --  which applies to a parent type from which E is derived.

      procedure Check_Duplicated_Export_Name (Nam : Node_Id);
      --  Nam is an N_String_Literal node containing the external name set by
      --  an Import or Export pragma (or extended Import or Export pragma).
      --  This procedure checks for possible duplications if this is the export
      --  case, and if found, issues an appropriate error message.

      procedure Check_Expr_Is_OK_Static_Expression
        (Expr : Node_Id;
         Typ  : Entity_Id := Empty);
      --  Check the specified expression Expr to make sure that it is a static
      --  expression of the given type (i.e. it will be analyzed and resolved
      --  using this type, which can be any valid argument to Resolve, e.g.
      --  Any_Integer is OK). If not, given error and raise Pragma_Exit. If
      --  Typ is left Empty, then any static expression is allowed. Includes
      --  checking that the expression does not raise Constraint_Error.

      procedure Check_First_Subtype (Arg : Node_Id);
      --  Checks that Arg, whose expression is an entity name, references a
      --  first subtype.

      procedure Check_Identifier (Arg : Node_Id; Id : Name_Id);
      --  Checks that the given argument has an identifier, and if so, requires
      --  it to match the given identifier name. If there is no identifier, or
      --  a non-matching identifier, then an error message is given and
      --  Pragma_Exit is raised.

      procedure Check_Identifier_Is_One_Of (Arg : Node_Id; N1, N2 : Name_Id);
      --  Checks that the given argument has an identifier, and if so, requires
      --  it to match one of the given identifier names. If there is no
      --  identifier, or a non-matching identifier, then an error message is
      --  given and Pragma_Exit is raised.

      procedure Check_In_Main_Program;
      --  Common checks for pragmas that appear within a main program
      --  (Priority, Main_Storage, Time_Slice, Relative_Deadline, CPU).

      procedure Check_Interrupt_Or_Attach_Handler;
      --  Common processing for first argument of pragma Interrupt_Handler or
      --  pragma Attach_Handler.

      procedure Check_Loop_Pragma_Placement;
      --  Verify whether pragmas Loop_Invariant, Loop_Optimize and Loop_Variant
      --  appear immediately within a construct restricted to loops, and that
      --  pragmas Loop_Invariant and Loop_Variant are grouped together.

      procedure Check_Is_In_Decl_Part_Or_Package_Spec;
      --  Check that pragma appears in a declarative part, or in a package
      --  specification, i.e. that it does not occur in a statement sequence
      --  in a body.

      procedure Check_No_Identifier (Arg : Node_Id);
      --  Checks that the given argument does not have an identifier. If
      --  an identifier is present, then an error message is issued, and
      --  Pragma_Exit is raised.

      procedure Check_No_Identifiers;
      --  Checks that none of the arguments to the pragma has an identifier.
      --  If any argument has an identifier, then an error message is issued,
      --  and Pragma_Exit is raised.

      procedure Check_No_Link_Name;
      --  Checks that no link name is specified

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : Name_Id);
      --  Checks if the given argument has an identifier, and if so, requires
      --  it to match the given identifier name. If there is a non-matching
      --  identifier, then an error message is given and Pragma_Exit is raised.

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : String);
      --  Checks if the given argument has an identifier, and if so, requires
      --  it to match the given identifier name. If there is a non-matching
      --  identifier, then an error message is given and Pragma_Exit is raised.
      --  In this version of the procedure, the identifier name is given as
      --  a string with lower case letters.

      procedure Check_Static_Boolean_Expression (Expr : Node_Id);
      --  Subsidiary to the analysis of pragmas Async_Readers, Async_Writers,
      --  Constant_After_Elaboration, Effective_Reads, Effective_Writes,
      --  Extensions_Visible and Volatile_Function. Ensure that expression Expr
      --  is an OK static boolean expression. Emit an error if this is not the
      --  case.

      procedure Check_Static_Constraint (Constr : Node_Id);
      --  Constr is a constraint from an N_Subtype_Indication node from a
      --  component constraint in an Unchecked_Union type. This routine checks
      --  that the constraint is static as required by the restrictions for
      --  Unchecked_Union.

      procedure Check_Valid_Configuration_Pragma;
      --  Legality checks for placement of a configuration pragma

      procedure Check_Valid_Library_Unit_Pragma;
      --  Legality checks for library unit pragmas. A special case arises for
      --  pragmas in generic instances that come from copies of the original
      --  library unit pragmas in the generic templates. In the case of other
      --  than library level instantiations these can appear in contexts which
      --  would normally be invalid (they only apply to the original template
      --  and to library level instantiations), and they are simply ignored,
      --  which is implemented by rewriting them as null statements.

      procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id);
      --  Check an Unchecked_Union variant for lack of nested variants and
      --  presence of at least one component. UU_Typ is the related Unchecked_
      --  Union type.

      procedure Ensure_Aggregate_Form (Arg : Node_Id);
      --  Subsidiary routine to the processing of pragmas Abstract_State,
      --  Contract_Cases, Depends, Global, Initializes, Refined_Depends,
      --  Refined_Global and Refined_State. Transform argument Arg into
      --  an aggregate if not one already. N_Null is never transformed.
      --  Arg may denote an aspect specification or a pragma argument
      --  association.

      procedure Error_Pragma (Msg : String);
      pragma No_Return (Error_Pragma);
      --  Outputs error message for current pragma. The message contains a %
      --  that will be replaced with the pragma name, and the flag is placed
      --  on the pragma itself. Pragma_Exit is then raised. Note: this routine
      --  calls Fix_Error (see spec of that procedure for details).

      procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id);
      pragma No_Return (Error_Pragma_Arg);
      --  Outputs error message for current pragma. The message may contain
      --  a % that will be replaced with the pragma name. The parameter Arg
      --  may either be a pragma argument association, in which case the flag
      --  is placed on the expression of this association, or an expression,
      --  in which case the flag is placed directly on the expression. The
      --  message is placed using Error_Msg_N, so the message may also contain
      --  an & insertion character which will reference the given Arg value.
      --  After placing the message, Pragma_Exit is raised. Note: this routine
      --  calls Fix_Error (see spec of that procedure for details).

      procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id);
      pragma No_Return (Error_Pragma_Arg);
      --  Similar to above form of Error_Pragma_Arg except that two messages
      --  are provided, the second is a continuation comment starting with \.

      procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id);
      pragma No_Return (Error_Pragma_Arg_Ident);
      --  Outputs error message for current pragma. The message may contain a %
      --  that will be replaced with the pragma name. The parameter Arg must be
      --  a pragma argument association with a non-empty identifier (i.e. its
      --  Chars field must be set), and the error message is placed on the
      --  identifier. The message is placed using Error_Msg_N so the message
      --  may also contain an & insertion character which will reference
      --  the identifier. After placing the message, Pragma_Exit is raised.
      --  Note: this routine calls Fix_Error (see spec of that procedure for
      --  details).

      procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id);
      pragma No_Return (Error_Pragma_Ref);
      --  Outputs error message for current pragma. The message may contain
      --  a % that will be replaced with the pragma name. The parameter Ref
      --  must be an entity whose name can be referenced by & and sloc by #.
      --  After placing the message, Pragma_Exit is raised. Note: this routine
      --  calls Fix_Error (see spec of that procedure for details).

      function Find_Lib_Unit_Name return Entity_Id;
      --  Used for a library unit pragma to find the entity to which the
      --  library unit pragma applies, returns the entity found.

      procedure Find_Program_Unit_Name (Id : Node_Id);
      --  If the pragma is a compilation unit pragma, the id must denote the
      --  compilation unit in the same compilation, and the pragma must appear
      --  in the list of preceding or trailing pragmas. If it is a program
      --  unit pragma that is not a compilation unit pragma, then the
      --  identifier must be visible.

      function Find_Unique_Parameterless_Procedure
        (Name : Entity_Id;
         Arg  : Node_Id) return Entity_Id;
      --  Used for a procedure pragma to find the unique parameterless
      --  procedure identified by Name, returns it if it exists, otherwise
      --  errors out and uses Arg as the pragma argument for the message.

      function Fix_Error (Msg : String) return String;
      --  This is called prior to issuing an error message. Msg is the normal
      --  error message issued in the pragma case. This routine checks for the
      --  case of a pragma coming from an aspect in the source, and returns a
      --  message suitable for the aspect case as follows:
      --
      --    Each substring "pragma" is replaced by "aspect"
      --
      --    If "argument of" is at the start of the error message text, it is
      --    replaced by "entity for".
      --
      --    If "argument" is at the start of the error message text, it is
      --    replaced by "entity".
      --
      --  So for example, "argument of pragma X must be discrete type"
      --  returns "entity for aspect X must be a discrete type".

      --  Finally Error_Msg_Name_1 is set to the name of the aspect (which may
      --  be different from the pragma name). If the current pragma results
      --  from rewriting another pragma, then Error_Msg_Name_1 is set to the
      --  original pragma name.

      procedure Gather_Associations
        (Names : Name_List;
         Args  : out Args_List);
      --  This procedure is used to gather the arguments for a pragma that
      --  permits arbitrary ordering of parameters using the normal rules
      --  for named and positional parameters. The Names argument is a list
      --  of Name_Id values that corresponds to the allowed pragma argument
      --  association identifiers in order. The result returned in Args is
      --  a list of corresponding expressions that are the pragma arguments.
      --  Note that this is a list of expressions, not of pragma argument
      --  associations (Gather_Associations has completely checked all the
      --  optional identifiers when it returns). An entry in Args is Empty
      --  on return if the corresponding argument is not present.

      procedure GNAT_Pragma;
      --  Called for all GNAT defined pragmas to check the relevant restriction
      --  (No_Implementation_Pragmas).

      function Is_Before_First_Decl
        (Pragma_Node : Node_Id;
         Decls       : List_Id) return Boolean;
      --  Return True if Pragma_Node is before the first declarative item in
      --  Decls where Decls is the list of declarative items.

      function Is_Configuration_Pragma return Boolean;
      --  Determines if the placement of the current pragma is appropriate
      --  for a configuration pragma.

      function Is_In_Context_Clause return Boolean;
      --  Returns True if pragma appears within the context clause of a unit,
      --  and False for any other placement (does not generate any messages).

      function Is_Static_String_Expression (Arg : Node_Id) return Boolean;
      --  Analyzes the argument, and determines if it is a static string
      --  expression, returns True if so, False if non-static or not String.
      --  A special case is that a string literal returns True in Ada 83 mode
      --  (which has no such thing as static string expressions). Note that
      --  the call analyzes its argument, so this cannot be used for the case
      --  where an identifier might not be declared.

      procedure Pragma_Misplaced;
      pragma No_Return (Pragma_Misplaced);
      --  Issue fatal error message for misplaced pragma

      procedure Process_Atomic_Independent_Shared_Volatile;
      --  Common processing for pragmas Atomic, Independent, Shared, Volatile,
      --  Volatile_Full_Access. Note that Shared is an obsolete Ada 83 pragma
      --  and treated as being identical in effect to pragma Atomic.

      procedure Process_Compile_Time_Warning_Or_Error;
      --  Common processing for Compile_Time_Error and Compile_Time_Warning

      procedure Process_Convention
        (C   : out Convention_Id;
         Ent : out Entity_Id);
      --  Common processing for Convention, Interface, Import and Export.
      --  Checks first two arguments of pragma, and sets the appropriate
      --  convention value in the specified entity or entities. On return
      --  C is the convention, Ent is the referenced entity.

      procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id);
      --  Common processing for Disable/Enable_Atomic_Synchronization. Nam is
      --  Name_Suppress for Disable and Name_Unsuppress for Enable.

      procedure Process_Extended_Import_Export_Object_Pragma
        (Arg_Internal : Node_Id;
         Arg_External : Node_Id;
         Arg_Size     : Node_Id);
      --  Common processing for the pragmas Import/Export_Object. The three
      --  arguments correspond to the three named parameters of the pragmas. An
      --  argument is empty if the corresponding parameter is not present in
      --  the pragma.

      procedure Process_Extended_Import_Export_Internal_Arg
        (Arg_Internal : Node_Id := Empty);
      --  Common processing for all extended Import and Export pragmas. The
      --  argument is the pragma parameter for the Internal argument. If
      --  Arg_Internal is empty or inappropriate, an error message is posted.
      --  Otherwise, on normal return, the Entity_Field of Arg_Internal is
      --  set to identify the referenced entity.

      procedure Process_Extended_Import_Export_Subprogram_Pragma
        (Arg_Internal                 : Node_Id;
         Arg_External                 : Node_Id;
         Arg_Parameter_Types          : Node_Id;
         Arg_Result_Type              : Node_Id := Empty;
         Arg_Mechanism                : Node_Id;
         Arg_Result_Mechanism         : Node_Id := Empty);
      --  Common processing for all extended Import and Export pragmas applying
      --  to subprograms. The caller omits any arguments that do not apply to
      --  the pragma in question (for example, Arg_Result_Type can be non-Empty
      --  only in the Import_Function and Export_Function cases). The argument
      --  names correspond to the allowed pragma association identifiers.

      procedure Process_Generic_List;
      --  Common processing for Share_Generic and Inline_Generic

      procedure Process_Import_Or_Interface;
      --  Common processing for Import or Interface

      procedure Process_Import_Predefined_Type;
      --  Processing for completing a type with pragma Import. This is used
      --  to declare types that match predefined C types, especially for cases
      --  without corresponding Ada predefined type.

      type Inline_Status is (Suppressed, Disabled, Enabled);
      --  Inline status of a subprogram, indicated as follows:
      --    Suppressed: inlining is suppressed for the subprogram
      --    Disabled:   no inlining is requested for the subprogram
      --    Enabled:    inlining is requested/required for the subprogram

      procedure Process_Inline (Status : Inline_Status);
      --  Common processing for No_Inline, Inline and Inline_Always. Parameter
      --  indicates the inline status specified by the pragma.

      procedure Process_Interface_Name
        (Subprogram_Def : Entity_Id;
         Ext_Arg        : Node_Id;
         Link_Arg       : Node_Id;
         Prag           : Node_Id);
      --  Given the last two arguments of pragma Import, pragma Export, or
      --  pragma Interface_Name, performs validity checks and sets the
      --  Interface_Name field of the given subprogram entity to the
      --  appropriate external or link name, depending on the arguments given.
      --  Ext_Arg is always present, but Link_Arg may be missing. Note that
      --  Ext_Arg may represent the Link_Name if Link_Arg is missing, and
      --  appropriate named notation is used for Ext_Arg. If neither Ext_Arg
      --  nor Link_Arg is present, the interface name is set to the default
      --  from the subprogram name. In addition, the pragma itself is passed
      --  to analyze any expressions in the case the pragma came from an aspect
      --  specification.

      procedure Process_Interrupt_Or_Attach_Handler;
      --  Common processing for Interrupt and Attach_Handler pragmas

      procedure Process_Restrictions_Or_Restriction_Warnings (Warn : Boolean);
      --  Common processing for Restrictions and Restriction_Warnings pragmas.
      --  Warn is True for Restriction_Warnings, or for Restrictions if the
      --  flag Treat_Restrictions_As_Warnings is set, and False if this flag
      --  is not set in the Restrictions case.

      procedure Process_Suppress_Unsuppress (Suppress_Case : Boolean);
      --  Common processing for Suppress and Unsuppress. The boolean parameter
      --  Suppress_Case is True for the Suppress case, and False for the
      --  Unsuppress case.

      procedure Record_Independence_Check (N : Node_Id; E : Entity_Id);
      --  Subsidiary to the analysis of pragmas Independent[_Components].
      --  Record such a pragma N applied to entity E for future checks.

      procedure Set_Exported (E : Entity_Id; Arg : Node_Id);
      --  This procedure sets the Is_Exported flag for the given entity,
      --  checking that the entity was not previously imported. Arg is
      --  the argument that specified the entity. A check is also made
      --  for exporting inappropriate entities.

      procedure Set_Extended_Import_Export_External_Name
        (Internal_Ent : Entity_Id;
         Arg_External : Node_Id);
      --  Common processing for all extended import export pragmas. The first
      --  argument, Internal_Ent, is the internal entity, which has already
      --  been checked for validity by the caller. Arg_External is from the
      --  Import or Export pragma, and may be null if no External parameter
      --  was present. If Arg_External is present and is a non-null string
      --  (a null string is treated as the default), then the Interface_Name
      --  field of Internal_Ent is set appropriately.

      procedure Set_Imported (E : Entity_Id);
      --  This procedure sets the Is_Imported flag for the given entity,
      --  checking that it is not previously exported or imported.

      procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id);
      --  Mech is a parameter passing mechanism (see Import_Function syntax
      --  for MECHANISM_NAME). This routine checks that the mechanism argument
      --  has the right form, and if not issues an error message. If the
      --  argument has the right form then the Mechanism field of Ent is
      --  set appropriately.

      procedure Set_Rational_Profile;
      --  Activate the set of configuration pragmas and permissions that make
      --  up the Rational profile.

      procedure Set_Ravenscar_Profile (Profile : Profile_Name; N : Node_Id);
      --  Activate the set of configuration pragmas and restrictions that make
      --  up the Profile. Profile must be either GNAT_Extended_Ravenscar,
      --  GNAT_Ravenscar_EDF, or Ravenscar. N is the corresponding pragma node,
      --  which is used for error messages on any constructs violating the
      --  profile.

      procedure Validate_Acc_Condition_Clause (Clause : Node_Id);
      --  Make sure the argument of a given Acc_If clause is a Boolean

      procedure Validate_Acc_Data_Clause (Clause : Node_Id);
      --  Make sure the argument of an OpenAcc data clause (e.g. Copy, Copyin,
      --  Copyout...) is an identifier or an aggregate of identifiers.

      procedure Validate_Acc_Int_Expr_Clause (Clause : Node_Id);
      --  Make sure the argument of an OpenAcc clause is an Integer expression

      procedure Validate_Acc_Int_Expr_List_Clause (Clause : Node_Id);
      --  Make sure the argument of an OpenAcc clause is an Integer expression
      --  or a list of Integer expressions.

      procedure Validate_Acc_Loop_Collapse (Clause : Node_Id);
      --  Make sure that the parent loop of the Acc_Loop(Collapse => N) pragma
      --  contains at least N-1 nested loops.

      procedure Validate_Acc_Loop_Gang (Clause : Node_Id);
      --  Make sure the argument of the Gang clause of a Loop directive is
      --  either an integer expression or a (Static => integer expressions)
      --  aggregate.

      procedure Validate_Acc_Loop_Vector (Clause : Node_Id);
      --  When this procedure is called in a construct offloaded by an
      --  Acc_Kernels pragma, makes sure that a Vector_Length clause does
      --  not exist on said pragma. In all cases, make sure the argument
      --  is an Integer expression.

      procedure Validate_Acc_Loop_Worker (Clause : Node_Id);
      --  When this procedure is called in a construct offloaded by an
      --  Acc_Parallel pragma, makes sure that no argument has been given.
      --  When this procedure is called in a construct offloaded by an
      --  Acc_Kernels pragma and if Loop_Worker was given an argument,
      --  makes sure that the Num_Workers clause does not appear on the
      --  Acc_Kernels pragma and that the argument is an integer.

      procedure Validate_Acc_Name_Reduction (Clause : Node_Id);
      --  Make sure the reduction clause is an aggregate made of a string
      --  representing a supported reduction operation (i.e. "+", "*", "and",
      --  "or", "min" or "max") and either an identifier or aggregate of
      --  identifiers.

      procedure Validate_Acc_Size_Expressions (Clause : Node_Id);
      --  Makes sure that Clause is either an integer expression or an
      --  association with a Static as name and a list of integer expressions
      --  or "*" strings on the right hand side.

      ---------------
      -- Acc_First --
      ---------------

      function Acc_First (N : Node_Id) return Node_Id is
      begin
         if Nkind (N) = N_Aggregate then
            if Present (Expressions (N)) then
               return First (Expressions (N));

            elsif Present (Component_Associations (N)) then
               return Expression (First (Component_Associations (N)));
            end if;
         end if;

         return N;
      end Acc_First;

      --------------
      -- Acc_Next --
      --------------

      function Acc_Next (N : Node_Id) return Node_Id is
      begin
         if Nkind (Parent (N)) = N_Component_Association then
            return Expression (Next (Parent (N)));

         elsif Nkind (Parent (N)) = N_Aggregate then
            return Next (N);

         else
            return Empty;
         end if;
      end Acc_Next;

      ----------------------------------
      -- Acquire_Warning_Match_String --
      ----------------------------------

      procedure Acquire_Warning_Match_String (Arg : Node_Id) is
      begin
         String_To_Name_Buffer
           (Strval (Expr_Value_S (Get_Pragma_Arg (Arg))));

         --  Add asterisk at start if not already there

         if Name_Len > 0 and then Name_Buffer (1) /= '*' then
            Name_Buffer (2 .. Name_Len + 1) :=
              Name_Buffer (1 .. Name_Len);
            Name_Buffer (1) := '*';
            Name_Len := Name_Len + 1;
         end if;

         --  Add asterisk at end if not already there

         if Name_Buffer (Name_Len) /= '*' then
            Name_Len := Name_Len + 1;
            Name_Buffer (Name_Len) := '*';
         end if;
      end Acquire_Warning_Match_String;

      ---------------------
      -- Ada_2005_Pragma --
      ---------------------

      procedure Ada_2005_Pragma is
      begin
         if Ada_Version <= Ada_95 then
            Check_Restriction (No_Implementation_Pragmas, N);
         end if;
      end Ada_2005_Pragma;

      ---------------------
      -- Ada_2012_Pragma --
      ---------------------

      procedure Ada_2012_Pragma is
      begin
         if Ada_Version <= Ada_2005 then
            Check_Restriction (No_Implementation_Pragmas, N);
         end if;
      end Ada_2012_Pragma;

      ----------------------------
      -- Analyze_Depends_Global --
      ----------------------------

      procedure Analyze_Depends_Global
        (Spec_Id   : out Entity_Id;
         Subp_Decl : out Node_Id;
         Legal     : out Boolean)
      is
      begin
         --  Assume that the pragma is illegal

         Spec_Id   := Empty;
         Subp_Decl := Empty;
         Legal     := False;

         GNAT_Pragma;
         Check_Arg_Count (1);

         --  Ensure the proper placement of the pragma. Depends/Global must be
         --  associated with a subprogram declaration or a body that acts as a
         --  spec.

         Subp_Decl := Find_Related_Declaration_Or_Body (N, Do_Checks => True);

         --  Entry

         if Nkind (Subp_Decl) = N_Entry_Declaration then
            null;

         --  Generic subprogram

         elsif Nkind (Subp_Decl) = N_Generic_Subprogram_Declaration then
            null;

         --  Object declaration of a single concurrent type

         elsif Nkind (Subp_Decl) = N_Object_Declaration
           and then Is_Single_Concurrent_Object
                      (Unique_Defining_Entity (Subp_Decl))
         then
            null;

         --  Single task type

         elsif Nkind (Subp_Decl) = N_Single_Task_Declaration then
            null;

         --  Subprogram body acts as spec

         elsif Nkind (Subp_Decl) = N_Subprogram_Body
           and then No (Corresponding_Spec (Subp_Decl))
         then
            null;

         --  Subprogram body stub acts as spec

         elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
           and then No (Corresponding_Spec_Of_Stub (Subp_Decl))
         then
            null;

         --  Subprogram declaration

         elsif Nkind (Subp_Decl) = N_Subprogram_Declaration then
            null;

         --  Task type

         elsif Nkind (Subp_Decl) = N_Task_Type_Declaration then
            null;

         else
            Pragma_Misplaced;
            return;
         end if;

         --  If we get here, then the pragma is legal

         Legal   := True;
         Spec_Id := Unique_Defining_Entity (Subp_Decl);

         --  When the related context is an entry, the entry must belong to a
         --  protected unit (SPARK RM 6.1.4(6)).

         if Is_Entry_Declaration (Spec_Id)
           and then Ekind (Scope (Spec_Id)) /= E_Protected_Type
         then
            Pragma_Misplaced;
            return;

         --  When the related context is an anonymous object created for a
         --  simple concurrent type, the type must be a task
         --  (SPARK RM 6.1.4(6)).

         elsif Is_Single_Concurrent_Object (Spec_Id)
           and then Ekind (Etype (Spec_Id)) /= E_Task_Type
         then
            Pragma_Misplaced;
            return;
         end if;

         --  A pragma that applies to a Ghost entity becomes Ghost for the
         --  purposes of legality checks and removal of ignored Ghost code.

         Mark_Ghost_Pragma (N, Spec_Id);
         Ensure_Aggregate_Form (Get_Argument (N, Spec_Id));
      end Analyze_Depends_Global;

      ------------------------
      -- Analyze_If_Present --
      ------------------------

      procedure Analyze_If_Present (Id : Pragma_Id) is
         Stmt : Node_Id;

      begin
         pragma Assert (Is_List_Member (N));

         --  Inspect the declarations or statements following pragma N looking
         --  for another pragma whose Id matches the caller's request. If it is
         --  available, analyze it.

         Stmt := Next (N);
         while Present (Stmt) loop
            if Nkind (Stmt) = N_Pragma and then Get_Pragma_Id (Stmt) = Id then
               Analyze_Pragma (Stmt);
               exit;

            --  The first source declaration or statement immediately following
            --  N ends the region where a pragma may appear.

            elsif Comes_From_Source (Stmt) then
               exit;
            end if;

            Next (Stmt);
         end loop;
      end Analyze_If_Present;

      --------------------------------
      -- Analyze_Pre_Post_Condition --
      --------------------------------

      procedure Analyze_Pre_Post_Condition is
         Prag_Iden : constant Node_Id := Pragma_Identifier (N);
         Subp_Decl : Node_Id;
         Subp_Id   : Entity_Id;

         Duplicates_OK : Boolean := False;
         --  Flag set when a pre/postcondition allows multiple pragmas of the
         --  same kind.

         In_Body_OK : Boolean := False;
         --  Flag set when a pre/postcondition is allowed to appear on a body
         --  even though the subprogram may have a spec.

         Is_Pre_Post : Boolean := False;
         --  Flag set when the pragma is one of Pre, Pre_Class, Post or
         --  Post_Class.

         function Inherits_Class_Wide_Pre (E : Entity_Id) return Boolean;
         --  Implement rules in AI12-0131: an overriding operation can have
         --  a class-wide precondition only if one of its ancestors has an
         --  explicit class-wide precondition.

         -----------------------------
         -- Inherits_Class_Wide_Pre --
         -----------------------------

         function Inherits_Class_Wide_Pre (E : Entity_Id) return Boolean is
            Typ  : constant Entity_Id := Find_Dispatching_Type (E);
            Cont : Node_Id;
            Prag : Node_Id;
            Prev : Entity_Id := Overridden_Operation (E);

         begin
            --  Check ancestors on the overriding operation to examine the
            --  preconditions that may apply to them.

            while Present (Prev) loop
               Cont := Contract (Prev);
               if Present (Cont) then
                  Prag := Pre_Post_Conditions (Cont);
                  while Present (Prag) loop
                     if Pragma_Name (Prag) = Name_Precondition
                       and then Class_Present (Prag)
                     then
                        return True;
                     end if;

                     Prag := Next_Pragma (Prag);
                  end loop;
               end if;

               --  For a type derived from a generic formal type, the operation
               --  inheriting the condition is a renaming, not an overriding of
               --  the operation of the formal. Ditto for an inherited
               --  operation which has no explicit contracts.

               if Is_Generic_Type (Find_Dispatching_Type (Prev))
                 or else not Comes_From_Source (Prev)
               then
                  Prev := Alias (Prev);
               else
                  Prev := Overridden_Operation (Prev);
               end if;
            end loop;

            --  If the controlling type of the subprogram has progenitors, an
            --  interface operation implemented by the current operation may
            --  have a class-wide precondition.

            if Has_Interfaces (Typ) then
               declare
                  Elmt      : Elmt_Id;
                  Ints      : Elist_Id;
                  Prim      : Entity_Id;
                  Prim_Elmt : Elmt_Id;
                  Prim_List : Elist_Id;

               begin
                  Collect_Interfaces (Typ, Ints);
                  Elmt := First_Elmt (Ints);

                  --  Iterate over the primitive operations of each interface

                  while Present (Elmt) loop
                     Prim_List := Direct_Primitive_Operations (Node (Elmt));
                     Prim_Elmt := First_Elmt (Prim_List);
                     while Present (Prim_Elmt) loop
                        Prim := Node (Prim_Elmt);
                        if Chars (Prim) = Chars (E)
                          and then Present (Contract (Prim))
                          and then Class_Present
                                     (Pre_Post_Conditions (Contract (Prim)))
                        then
                           return True;
                        end if;

                        Next_Elmt (Prim_Elmt);
                     end loop;

                     Next_Elmt (Elmt);
                  end loop;
               end;
            end if;

            return False;
         end Inherits_Class_Wide_Pre;

      --  Start of processing for Analyze_Pre_Post_Condition

      begin
         --  Change the name of pragmas Pre, Pre_Class, Post and Post_Class to
         --  offer uniformity among the various kinds of pre/postconditions by
         --  rewriting the pragma identifier. This allows the retrieval of the
         --  original pragma name by routine Original_Aspect_Pragma_Name.

         if Comes_From_Source (N) then
            if Nam_In (Pname, Name_Pre, Name_Pre_Class) then
               Is_Pre_Post := True;
               Set_Class_Present (N, Pname = Name_Pre_Class);
               Rewrite (Prag_Iden, Make_Identifier (Loc, Name_Precondition));

            elsif Nam_In (Pname, Name_Post, Name_Post_Class) then
               Is_Pre_Post := True;
               Set_Class_Present (N, Pname = Name_Post_Class);
               Rewrite (Prag_Iden, Make_Identifier (Loc, Name_Postcondition));
            end if;
         end if;

         --  Determine the semantics with respect to duplicates and placement
         --  in a body. Pragmas Precondition and Postcondition were introduced
         --  before aspects and are not subject to the same aspect-like rules.

         if Nam_In (Pname, Name_Precondition, Name_Postcondition) then
            Duplicates_OK := True;
            In_Body_OK    := True;
         end if;

         GNAT_Pragma;

         --  Pragmas Pre, Pre_Class, Post and Post_Class allow for a single
         --  argument without an identifier.

         if Is_Pre_Post then
            Check_Arg_Count (1);
            Check_No_Identifiers;

         --  Pragmas Precondition and Postcondition have complex argument
         --  profile.

         else
            Check_At_Least_N_Arguments (1);
            Check_At_Most_N_Arguments  (2);
            Check_Optional_Identifier (Arg1, Name_Check);

            if Present (Arg2) then
               Check_Optional_Identifier (Arg2, Name_Message);
               Preanalyze_Spec_Expression
                 (Get_Pragma_Arg (Arg2), Standard_String);
            end if;
         end if;

         --  For a pragma PPC in the extended main source unit, record enabled
         --  status in SCO.
         --  ??? nothing checks that the pragma is in the main source unit

         if Is_Checked (N) and then not Split_PPC (N) then
            Set_SCO_Pragma_Enabled (Loc);
         end if;

         --  Ensure the proper placement of the pragma

         Subp_Decl :=
           Find_Related_Declaration_Or_Body
             (N, Do_Checks => not Duplicates_OK);

         --  When a pre/postcondition pragma applies to an abstract subprogram,
         --  its original form must be an aspect with 'Class.

         if Nkind (Subp_Decl) = N_Abstract_Subprogram_Declaration then
            if not From_Aspect_Specification (N) then
               Error_Pragma
                 ("pragma % cannot be applied to abstract subprogram");

            elsif not Class_Present (N) then
               Error_Pragma
                 ("aspect % requires ''Class for abstract subprogram");
            end if;

         --  Entry declaration

         elsif Nkind (Subp_Decl) = N_Entry_Declaration then
            null;

         --  Generic subprogram declaration

         elsif Nkind (Subp_Decl) = N_Generic_Subprogram_Declaration then
            null;

         --  Subprogram body

         elsif Nkind (Subp_Decl) = N_Subprogram_Body
           and then (No (Corresponding_Spec (Subp_Decl)) or In_Body_OK)
         then
            null;

         --  Subprogram body stub

         elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
           and then (No (Corresponding_Spec_Of_Stub (Subp_Decl)) or In_Body_OK)
         then
            null;

         --  Subprogram declaration

         elsif Nkind (Subp_Decl) = N_Subprogram_Declaration then

            --  AI05-0230: When a pre/postcondition pragma applies to a null
            --  procedure, its original form must be an aspect with 'Class.

            if Nkind (Specification (Subp_Decl)) = N_Procedure_Specification
              and then Null_Present (Specification (Subp_Decl))
              and then From_Aspect_Specification (N)
              and then not Class_Present (N)
            then
               Error_Pragma ("aspect % requires ''Class for null procedure");
            end if;

            --  Implement the legality checks mandated by AI12-0131:
            --    Pre'Class shall not be specified for an overriding primitive
            --    subprogram of a tagged type T unless the Pre'Class aspect is
            --    specified for the corresponding primitive subprogram of some
            --    ancestor of T.

            declare
               E : constant Entity_Id := Defining_Entity (Subp_Decl);

            begin
               if Class_Present (N)
                 and then Pragma_Name (N) = Name_Precondition
                 and then Present (Overridden_Operation (E))
                 and then not Inherits_Class_Wide_Pre (E)
               then
                  Error_Msg_N
                    ("illegal class-wide precondition on overriding operation",
                     Corresponding_Aspect (N));
               end if;
            end;

         --  A renaming declaration may inherit a generated pragma, its
         --  placement comes from expansion, not from source.

         elsif Nkind (Subp_Decl) = N_Subprogram_Renaming_Declaration
           and then not Comes_From_Source (N)
         then
            null;

         --  Otherwise the placement is illegal

         else
            Pragma_Misplaced;
            return;
         end if;

         Subp_Id := Defining_Entity (Subp_Decl);

         --  A pragma that applies to a Ghost entity becomes Ghost for the
         --  purposes of legality checks and removal of ignored Ghost code.

         Mark_Ghost_Pragma (N, Subp_Id);

         --  Chain the pragma on the contract for further processing by
         --  Analyze_Pre_Post_Condition_In_Decl_Part.

         Add_Contract_Item (N, Defining_Entity (Subp_Decl));

         --  Fully analyze the pragma when it appears inside an entry or
         --  subprogram body because it cannot benefit from forward references.

         if Nkind_In (Subp_Decl, N_Entry_Body,
                                 N_Subprogram_Body,
                                 N_Subprogram_Body_Stub)
         then
            --  The legality checks of pragmas Precondition and Postcondition
            --  are affected by the SPARK mode in effect and the volatility of
            --  the context. Analyze all pragmas in a specific order.

            Analyze_If_Present (Pragma_SPARK_Mode);
            Analyze_If_Present (Pragma_Volatile_Function);
            Analyze_Pre_Post_Condition_In_Decl_Part (N);
         end if;
      end Analyze_Pre_Post_Condition;

      -----------------------------------------
      -- Analyze_Refined_Depends_Global_Post --
      -----------------------------------------

      procedure Analyze_Refined_Depends_Global_Post
        (Spec_Id : out Entity_Id;
         Body_Id : out Entity_Id;
         Legal   : out Boolean)
      is
         Body_Decl : Node_Id;
         Spec_Decl : Node_Id;

      begin
         --  Assume that the pragma is illegal

         Spec_Id := Empty;
         Body_Id := Empty;
         Legal   := False;

         GNAT_Pragma;
         Check_Arg_Count (1);
         Check_No_Identifiers;

         --  Verify the placement of the pragma and check for duplicates. The
         --  pragma must apply to a subprogram body [stub].

         Body_Decl := Find_Related_Declaration_Or_Body (N, Do_Checks => True);

         if not Nkind_In (Body_Decl, N_Entry_Body,
                                     N_Subprogram_Body,
                                     N_Subprogram_Body_Stub,
                                     N_Task_Body,
                                     N_Task_Body_Stub)
         then
            Pragma_Misplaced;
            return;
         end if;

         Body_Id := Defining_Entity (Body_Decl);
         Spec_Id := Unique_Defining_Entity (Body_Decl);

         --  The pragma must apply to the second declaration of a subprogram.
         --  In other words, the body [stub] cannot acts as a spec.

         if No (Spec_Id) then
            Error_Pragma ("pragma % cannot apply to a stand alone body");
            return;

         --  Catch the case where the subprogram body is a subunit and acts as
         --  the third declaration of the subprogram.

         elsif Nkind (Parent (Body_Decl)) = N_Subunit then
            Error_Pragma ("pragma % cannot apply to a subunit");
            return;
         end if;

         --  A refined pragma can only apply to the body [stub] of a subprogram
         --  declared in the visible part of a package. Retrieve the context of
         --  the subprogram declaration.

         Spec_Decl := Unit_Declaration_Node (Spec_Id);

         --  When dealing with protected entries or protected subprograms, use
         --  the enclosing protected type as the proper context.

         if Ekind_In (Spec_Id, E_Entry,
                               E_Entry_Family,
                               E_Function,
                               E_Procedure)
           and then Ekind (Scope (Spec_Id)) = E_Protected_Type
         then
            Spec_Decl := Declaration_Node (Scope (Spec_Id));
         end if;

         if Nkind (Parent (Spec_Decl)) /= N_Package_Specification then
            Error_Pragma
              (Fix_Msg (Spec_Id, "pragma % must apply to the body of "
               & "subprogram declared in a package specification"));
            return;
         end if;

         --  If we get here, then the pragma is legal

         Legal := True;

         --  A pragma that applies to a Ghost entity becomes Ghost for the
         --  purposes of legality checks and removal of ignored Ghost code.

         Mark_Ghost_Pragma (N, Spec_Id);

         if Nam_In (Pname, Name_Refined_Depends, Name_Refined_Global) then
            Ensure_Aggregate_Form (Get_Argument (N, Spec_Id));
         end if;
      end Analyze_Refined_Depends_Global_Post;

      ----------------------------------
      -- Analyze_Unmodified_Or_Unused --
      ----------------------------------

      procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False) is
         Arg      : Node_Id;
         Arg_Expr : Node_Id;
         Arg_Id   : Entity_Id;

         Ghost_Error_Posted : Boolean := False;
         --  Flag set when an error concerning the illegal mix of Ghost and
         --  non-Ghost variables is emitted.

         Ghost_Id : Entity_Id := Empty;
         --  The entity of the first Ghost variable encountered while
         --  processing the arguments of the pragma.

      begin
         GNAT_Pragma;
         Check_At_Least_N_Arguments (1);

         --  Loop through arguments

         Arg := Arg1;
         while Present (Arg) loop
            Check_No_Identifier (Arg);

            --  Note: the analyze call done by Check_Arg_Is_Local_Name will
            --  in fact generate reference, so that the entity will have a
            --  reference, which will inhibit any warnings about it not
            --  being referenced, and also properly show up in the ali file
            --  as a reference. But this reference is recorded before the
            --  Has_Pragma_Unreferenced flag is set, so that no warning is
            --  generated for this reference.

            Check_Arg_Is_Local_Name (Arg);
            Arg_Expr := Get_Pragma_Arg (Arg);

            if Is_Entity_Name (Arg_Expr) then
               Arg_Id := Entity (Arg_Expr);

               --  Skip processing the argument if already flagged

               if Is_Assignable (Arg_Id)
                 and then not Has_Pragma_Unmodified (Arg_Id)
                 and then not Has_Pragma_Unused (Arg_Id)
               then
                  Set_Has_Pragma_Unmodified (Arg_Id);

                  if Is_Unused then
                     Set_Has_Pragma_Unused (Arg_Id);
                  end if;

                  --  A pragma that applies to a Ghost entity becomes Ghost for
                  --  the purposes of legality checks and removal of ignored
                  --  Ghost code.

                  Mark_Ghost_Pragma (N, Arg_Id);

                  --  Capture the entity of the first Ghost variable being
                  --  processed for error detection purposes.

                  if Is_Ghost_Entity (Arg_Id) then
                     if No (Ghost_Id) then
                        Ghost_Id := Arg_Id;
                     end if;

                  --  Otherwise the variable is non-Ghost. It is illegal to mix
                  --  references to Ghost and non-Ghost entities
                  --  (SPARK RM 6.9).

                  elsif Present (Ghost_Id)
                    and then not Ghost_Error_Posted
                  then
                     Ghost_Error_Posted := True;

                     Error_Msg_Name_1 := Pname;
                     Error_Msg_N
                       ("pragma % cannot mention ghost and non-ghost "
                        & "variables", N);

                     Error_Msg_Sloc := Sloc (Ghost_Id);
                     Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);

                     Error_Msg_Sloc := Sloc (Arg_Id);
                     Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id);
                  end if;

               --  Warn if already flagged as Unused or Unmodified

               elsif Has_Pragma_Unmodified (Arg_Id) then
                  if Has_Pragma_Unused (Arg_Id) then
                     Error_Msg_NE
                       ("??pragma Unused already given for &!", Arg_Expr,
                         Arg_Id);
                  else
                     Error_Msg_NE
                       ("??pragma Unmodified already given for &!", Arg_Expr,
                         Arg_Id);
                  end if;

               --  Otherwise the pragma referenced an illegal entity

               else
                  Error_Pragma_Arg
                    ("pragma% can only be applied to a variable", Arg_Expr);
               end if;
            end if;

            Next (Arg);
         end loop;
      end Analyze_Unmodified_Or_Unused;

      ------------------------------------
      -- Analyze_Unreferenced_Or_Unused --
      ------------------------------------

      procedure Analyze_Unreferenced_Or_Unused
        (Is_Unused : Boolean := False)
      is
         Arg      : Node_Id;
         Arg_Expr : Node_Id;
         Arg_Id   : Entity_Id;
         Citem    : Node_Id;

         Ghost_Error_Posted : Boolean := False;
         --  Flag set when an error concerning the illegal mix of Ghost and
         --  non-Ghost names is emitted.

         Ghost_Id : Entity_Id := Empty;
         --  The entity of the first Ghost name encountered while processing
         --  the arguments of the pragma.

      begin
         GNAT_Pragma;
         Check_At_Least_N_Arguments (1);

         --  Check case of appearing within context clause

         if not Is_Unused and then Is_In_Context_Clause then

            --  The arguments must all be units mentioned in a with clause in
            --  the same context clause. Note that Par.Prag already checked
            --  that the arguments are either identifiers or selected
            --  components.

            Arg := Arg1;
            while Present (Arg) loop
               Citem := First (List_Containing (N));
               while Citem /= N loop
                  Arg_Expr := Get_Pragma_Arg (Arg);

                  if Nkind (Citem) = N_With_Clause
                    and then Same_Name (Name (Citem), Arg_Expr)
                  then
                     Set_Has_Pragma_Unreferenced
                       (Cunit_Entity
                         (Get_Source_Unit
                           (Library_Unit (Citem))));
                     Set_Elab_Unit_Name (Arg_Expr, Name (Citem));
                     exit;
                  end if;

                  Next (Citem);
               end loop;

               if Citem = N then
                  Error_Pragma_Arg
                    ("argument of pragma% is not withed unit", Arg);
               end if;

               Next (Arg);
            end loop;

         --  Case of not in list of context items

         else
            Arg := Arg1;
            while Present (Arg) loop
               Check_No_Identifier (Arg);

               --  Note: the analyze call done by Check_Arg_Is_Local_Name will
               --  in fact generate reference, so that the entity will have a
               --  reference, which will inhibit any warnings about it not
               --  being referenced, and also properly show up in the ali file
               --  as a reference. But this reference is recorded before the
               --  Has_Pragma_Unreferenced flag is set, so that no warning is
               --  generated for this reference.

               Check_Arg_Is_Local_Name (Arg);
               Arg_Expr := Get_Pragma_Arg (Arg);

               if Is_Entity_Name (Arg_Expr) then
                  Arg_Id := Entity (Arg_Expr);

                  --  Warn if already flagged as Unused or Unreferenced and
                  --  skip processing the argument.

                  if Has_Pragma_Unreferenced (Arg_Id) then
                     if Has_Pragma_Unused (Arg_Id) then
                        Error_Msg_NE
                          ("??pragma Unused already given for &!", Arg_Expr,
                            Arg_Id);
                     else
                        Error_Msg_NE
                          ("??pragma Unreferenced already given for &!",
                            Arg_Expr, Arg_Id);
                     end if;

                  --  Apply Unreferenced to the entity

                  else
                     --  If the entity is overloaded, the pragma applies to the
                     --  most recent overloading, as documented. In this case,
                     --  name resolution does not generate a reference, so it
                     --  must be done here explicitly.

                     if Is_Overloaded (Arg_Expr) then
                        Generate_Reference (Arg_Id, N);
                     end if;

                     Set_Has_Pragma_Unreferenced (Arg_Id);

                     if Is_Unused then
                        Set_Has_Pragma_Unused (Arg_Id);
                     end if;

                     --  A pragma that applies to a Ghost entity becomes Ghost
                     --  for the purposes of legality checks and removal of
                     --  ignored Ghost code.

                     Mark_Ghost_Pragma (N, Arg_Id);

                     --  Capture the entity of the first Ghost name being
                     --  processed for error detection purposes.

                     if Is_Ghost_Entity (Arg_Id) then
                        if No (Ghost_Id) then
                           Ghost_Id := Arg_Id;
                        end if;

                     --  Otherwise the name is non-Ghost. It is illegal to mix
                     --  references to Ghost and non-Ghost entities
                     --  (SPARK RM 6.9).

                     elsif Present (Ghost_Id)
                       and then not Ghost_Error_Posted
                     then
                        Ghost_Error_Posted := True;

                        Error_Msg_Name_1 := Pname;
                        Error_Msg_N
                          ("pragma % cannot mention ghost and non-ghost "
                           & "names", N);

                        Error_Msg_Sloc := Sloc (Ghost_Id);
                        Error_Msg_NE
                          ("\& # declared as ghost", N, Ghost_Id);

                        Error_Msg_Sloc := Sloc (Arg_Id);
                        Error_Msg_NE
                          ("\& # declared as non-ghost", N, Arg_Id);
                     end if;
                  end if;
               end if;

               Next (Arg);
            end loop;
         end if;
      end Analyze_Unreferenced_Or_Unused;

      --------------------------
      -- Check_Ada_83_Warning --
      --------------------------

      procedure Check_Ada_83_Warning is
      begin
         if Ada_Version = Ada_83 and then Comes_From_Source (N) then
            Error_Msg_N ("(Ada 83) pragma& is non-standard??", N);
         end if;
      end Check_Ada_83_Warning;

      ---------------------
      -- Check_Arg_Count --
      ---------------------

      procedure Check_Arg_Count (Required : Nat) is
      begin
         if Arg_Count /= Required then
            Error_Pragma ("wrong number of arguments for pragma%");
         end if;
      end Check_Arg_Count;

      --------------------------------
      -- Check_Arg_Is_External_Name --
      --------------------------------

      procedure Check_Arg_Is_External_Name (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         if Nkind (Argx) = N_Identifier then
            return;

         else
            Analyze_And_Resolve (Argx, Standard_String);

            if Is_OK_Static_Expression (Argx) then
               return;

            elsif Etype (Argx) = Any_Type then
               raise Pragma_Exit;

            --  An interesting special case, if we have a string literal and
            --  we are in Ada 83 mode, then we allow it even though it will
            --  not be flagged as static. This allows expected Ada 83 mode
            --  use of external names which are string literals, even though
            --  technically these are not static in Ada 83.

            elsif Ada_Version = Ada_83
              and then Nkind (Argx) = N_String_Literal
            then
               return;

            --  Here we have a real error (non-static expression)

            else
               Error_Msg_Name_1 := Pname;
               Flag_Non_Static_Expr
                 (Fix_Error ("argument for pragma% must be a identifier or "
                  & "static string expression!"), Argx);

               raise Pragma_Exit;
            end if;
         end if;
      end Check_Arg_Is_External_Name;

      -----------------------------
      -- Check_Arg_Is_Identifier --
      -----------------------------

      procedure Check_Arg_Is_Identifier (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);
      begin
         if Nkind (Argx) /= N_Identifier then
            Error_Pragma_Arg ("argument for pragma% must be identifier", Argx);
         end if;
      end Check_Arg_Is_Identifier;

      ----------------------------------
      -- Check_Arg_Is_Integer_Literal --
      ----------------------------------

      procedure Check_Arg_Is_Integer_Literal (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);
      begin
         if Nkind (Argx) /= N_Integer_Literal then
            Error_Pragma_Arg
              ("argument for pragma% must be integer literal", Argx);
         end if;
      end Check_Arg_Is_Integer_Literal;

      -------------------------------------------
      -- Check_Arg_Is_Library_Level_Local_Name --
      -------------------------------------------

      --  LOCAL_NAME ::=
      --    DIRECT_NAME
      --  | DIRECT_NAME'ATTRIBUTE_DESIGNATOR
      --  | library_unit_NAME

      procedure Check_Arg_Is_Library_Level_Local_Name (Arg : Node_Id) is
      begin
         Check_Arg_Is_Local_Name (Arg);

         --  If it came from an aspect, we want to give the error just as if it
         --  came from source.

         if not Is_Library_Level_Entity (Entity (Get_Pragma_Arg (Arg)))
           and then (Comes_From_Source (N)
                       or else Present (Corresponding_Aspect (Parent (Arg))))
         then
            Error_Pragma_Arg
              ("argument for pragma% must be library level entity", Arg);
         end if;
      end Check_Arg_Is_Library_Level_Local_Name;

      -----------------------------
      -- Check_Arg_Is_Local_Name --
      -----------------------------

      --  LOCAL_NAME ::=
      --    DIRECT_NAME
      --  | DIRECT_NAME'ATTRIBUTE_DESIGNATOR
      --  | library_unit_NAME

      procedure Check_Arg_Is_Local_Name (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         --  If this pragma came from an aspect specification, we don't want to
         --  check for this error, because that would cause spurious errors, in
         --  case a type is frozen in a scope more nested than the type. The
         --  aspect itself of course can't be anywhere but on the declaration
         --  itself.

         if Nkind (Arg) = N_Pragma_Argument_Association then
            if From_Aspect_Specification (Parent (Arg)) then
               return;
            end if;

         --  Arg is the Expression of an N_Pragma_Argument_Association

         else
            if From_Aspect_Specification (Parent (Parent (Arg))) then
               return;
            end if;
         end if;

         Analyze (Argx);

         if Nkind (Argx) not in N_Direct_Name
           and then (Nkind (Argx) /= N_Attribute_Reference
                      or else Present (Expressions (Argx))
                      or else Nkind (Prefix (Argx)) /= N_Identifier)
           and then (not Is_Entity_Name (Argx)
                      or else not Is_Compilation_Unit (Entity (Argx)))
         then
            Error_Pragma_Arg ("argument for pragma% must be local name", Argx);
         end if;

         --  No further check required if not an entity name

         if not Is_Entity_Name (Argx) then
            null;

         else
            declare
               OK   : Boolean;
               Ent  : constant Entity_Id := Entity (Argx);
               Scop : constant Entity_Id := Scope (Ent);

            begin
               --  Case of a pragma applied to a compilation unit: pragma must
               --  occur immediately after the program unit in the compilation.

               if Is_Compilation_Unit (Ent) then
                  declare
                     Decl : constant Node_Id := Unit_Declaration_Node (Ent);

                  begin
                     --  Case of pragma placed immediately after spec

                     if Parent (N) = Aux_Decls_Node (Parent (Decl)) then
                        OK := True;

                     --  Case of pragma placed immediately after body

                     elsif Nkind (Decl) = N_Subprogram_Declaration
                             and then Present (Corresponding_Body (Decl))
                     then
                        OK := Parent (N) =
                                Aux_Decls_Node
                                  (Parent (Unit_Declaration_Node
                                             (Corresponding_Body (Decl))));

                     --  All other cases are illegal

                     else
                        OK := False;
                     end if;
                  end;

               --  Special restricted placement rule from 10.2.1(11.8/2)

               elsif Is_Generic_Formal (Ent)
                       and then Prag_Id = Pragma_Preelaborable_Initialization
               then
                  OK := List_Containing (N) =
                          Generic_Formal_Declarations
                            (Unit_Declaration_Node (Scop));

               --  If this is an aspect applied to a subprogram body, the
               --  pragma is inserted in its declarative part.

               elsif From_Aspect_Specification (N)
                 and then Ent = Current_Scope
                 and then
                   Nkind (Unit_Declaration_Node (Ent)) = N_Subprogram_Body
               then
                  OK := True;

               --  If the aspect is a predicate (possibly others ???) and the
               --  context is a record type, this is a discriminant expression
               --  within a type declaration, that freezes the predicated
               --  subtype.

               elsif From_Aspect_Specification (N)
                 and then Prag_Id = Pragma_Predicate
                 and then Ekind (Current_Scope) = E_Record_Type
                 and then Scop = Scope (Current_Scope)
               then
                  OK := True;

               --  Default case, just check that the pragma occurs in the scope
               --  of the entity denoted by the name.

               else
                  OK := Current_Scope = Scop;
               end if;

               if not OK then
                  Error_Pragma_Arg
                    ("pragma% argument must be in same declarative part", Arg);
               end if;
            end;
         end if;
      end Check_Arg_Is_Local_Name;

      ---------------------------------
      -- Check_Arg_Is_Locking_Policy --
      ---------------------------------

      procedure Check_Arg_Is_Locking_Policy (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Is_Locking_Policy_Name (Chars (Argx)) then
            Error_Pragma_Arg ("& is not a valid locking policy name", Argx);
         end if;
      end Check_Arg_Is_Locking_Policy;

      -----------------------------------------------
      -- Check_Arg_Is_Partition_Elaboration_Policy --
      -----------------------------------------------

      procedure Check_Arg_Is_Partition_Elaboration_Policy (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Is_Partition_Elaboration_Policy_Name (Chars (Argx)) then
            Error_Pragma_Arg
              ("& is not a valid partition elaboration policy name", Argx);
         end if;
      end Check_Arg_Is_Partition_Elaboration_Policy;

      -------------------------
      -- Check_Arg_Is_One_Of --
      -------------------------

      procedure Check_Arg_Is_One_Of (Arg : Node_Id; N1, N2 : Name_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Nam_In (Chars (Argx), N1, N2) then
            Error_Msg_Name_2 := N1;
            Error_Msg_Name_3 := N2;
            Error_Pragma_Arg ("argument for pragma% must be% or%", Argx);
         end if;
      end Check_Arg_Is_One_Of;

      procedure Check_Arg_Is_One_Of
        (Arg        : Node_Id;
         N1, N2, N3 : Name_Id)
      is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Nam_In (Chars (Argx), N1, N2, N3) then
            Error_Pragma_Arg ("invalid argument for pragma%", Argx);
         end if;
      end Check_Arg_Is_One_Of;

      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2, N3, N4     : Name_Id)
      is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Nam_In (Chars (Argx), N1, N2, N3, N4) then
            Error_Pragma_Arg ("invalid argument for pragma%", Argx);
         end if;
      end Check_Arg_Is_One_Of;

      procedure Check_Arg_Is_One_Of
        (Arg                : Node_Id;
         N1, N2, N3, N4, N5 : Name_Id)
      is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Nam_In (Chars (Argx), N1, N2, N3, N4, N5) then
            Error_Pragma_Arg ("invalid argument for pragma%", Argx);
         end if;
      end Check_Arg_Is_One_Of;

      ---------------------------------
      -- Check_Arg_Is_Queuing_Policy --
      ---------------------------------

      procedure Check_Arg_Is_Queuing_Policy (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Is_Queuing_Policy_Name (Chars (Argx)) then
            Error_Pragma_Arg ("& is not a valid queuing policy name", Argx);
         end if;
      end Check_Arg_Is_Queuing_Policy;

      ---------------------------------------
      -- Check_Arg_Is_OK_Static_Expression --
      ---------------------------------------

      procedure Check_Arg_Is_OK_Static_Expression
        (Arg : Node_Id;
         Typ : Entity_Id := Empty)
      is
      begin
         Check_Expr_Is_OK_Static_Expression (Get_Pragma_Arg (Arg), Typ);
      end Check_Arg_Is_OK_Static_Expression;

      ------------------------------------------
      -- Check_Arg_Is_Task_Dispatching_Policy --
      ------------------------------------------

      procedure Check_Arg_Is_Task_Dispatching_Policy (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);

      begin
         Check_Arg_Is_Identifier (Argx);

         if not Is_Task_Dispatching_Policy_Name (Chars (Argx)) then
            Error_Pragma_Arg
              ("& is not an allowed task dispatching policy name", Argx);
         end if;
      end Check_Arg_Is_Task_Dispatching_Policy;

      ---------------------
      -- Check_Arg_Order --
      ---------------------

      procedure Check_Arg_Order (Names : Name_List) is
         Arg : Node_Id;

         Highest_So_Far : Natural := 0;
         --  Highest index in Names seen do far

      begin
         Arg := Arg1;
         for J in 1 .. Arg_Count loop
            if Chars (Arg) /= No_Name then
               for K in Names'Range loop
                  if Chars (Arg) = Names (K) then
                     if K < Highest_So_Far then
                        Error_Msg_Name_1 := Pname;
                        Error_Msg_N
                          ("parameters out of order for pragma%", Arg);
                        Error_Msg_Name_1 := Names (K);
                        Error_Msg_Name_2 := Names (Highest_So_Far);
                        Error_Msg_N ("\% must appear before %", Arg);
                        raise Pragma_Exit;

                     else
                        Highest_So_Far := K;
                     end if;
                  end if;
               end loop;
            end if;

            Arg := Next (Arg);
         end loop;
      end Check_Arg_Order;

      --------------------------------
      -- Check_At_Least_N_Arguments --
      --------------------------------

      procedure Check_At_Least_N_Arguments (N : Nat) is
      begin
         if Arg_Count < N then
            Error_Pragma ("too few arguments for pragma%");
         end if;
      end Check_At_Least_N_Arguments;

      -------------------------------
      -- Check_At_Most_N_Arguments --
      -------------------------------

      procedure Check_At_Most_N_Arguments (N : Nat) is
         Arg : Node_Id;
      begin
         if Arg_Count > N then
            Arg := Arg1;
            for J in 1 .. N loop
               Next (Arg);
               Error_Pragma_Arg ("too many arguments for pragma%", Arg);
            end loop;
         end if;
      end Check_At_Most_N_Arguments;

      ---------------------
      -- Check_Component --
      ---------------------

      procedure Check_Component
        (Comp            : Node_Id;
         UU_Typ          : Entity_Id;
         In_Variant_Part : Boolean := False)
      is
         Comp_Id : constant Entity_Id := Defining_Identifier (Comp);
         Sindic  : constant Node_Id :=
                     Subtype_Indication (Component_Definition (Comp));
         Typ     : constant Entity_Id := Etype (Comp_Id);

      begin
         --  Ada 2005 (AI-216): If a component subtype is subject to a per-
         --  object constraint, then the component type shall be an Unchecked_
         --  Union.

         if Nkind (Sindic) = N_Subtype_Indication
           and then Has_Per_Object_Constraint (Comp_Id)
           and then not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic)))
         then
            Error_Msg_N
              ("component subtype subject to per-object constraint "
               & "must be an Unchecked_Union", Comp);

         --  Ada 2012 (AI05-0026): For an unchecked union type declared within
         --  the body of a generic unit, or within the body of any of its
         --  descendant library units, no part of the type of a component
         --  declared in a variant_part of the unchecked union type shall be of
         --  a formal private type or formal private extension declared within
         --  the formal part of the generic unit.

         elsif Ada_Version >= Ada_2012
           and then In_Generic_Body (UU_Typ)
           and then In_Variant_Part
           and then Is_Private_Type (Typ)
           and then Is_Generic_Type (Typ)
         then
            Error_Msg_N
              ("component of unchecked union cannot be of generic type", Comp);

         elsif Needs_Finalization (Typ) then
            Error_Msg_N
              ("component of unchecked union cannot be controlled", Comp);

         elsif Has_Task (Typ) then
            Error_Msg_N
              ("component of unchecked union cannot have tasks", Comp);
         end if;
      end Check_Component;

      ----------------------------
      -- Check_Duplicate_Pragma --
      ----------------------------

      procedure Check_Duplicate_Pragma (E : Entity_Id) is
         Id : Entity_Id := E;
         P  : Node_Id;

      begin
         --  Nothing to do if this pragma comes from an aspect specification,
         --  since we could not be duplicating a pragma, and we dealt with the
         --  case of duplicated aspects in Analyze_Aspect_Specifications.

         if From_Aspect_Specification (N) then
            return;
         end if;

         --  Otherwise current pragma may duplicate previous pragma or a
         --  previously given aspect specification or attribute definition
         --  clause for the same pragma.

         P := Get_Rep_Item (E, Pragma_Name (N), Check_Parents => False);

         if Present (P) then

            --  If the entity is a type, then we have to make sure that the
            --  ostensible duplicate is not for a parent type from which this
            --  type is derived.

            if Is_Type (E) then
               if Nkind (P) = N_Pragma then
                  declare
                     Args : constant List_Id :=
                              Pragma_Argument_Associations (P);
                  begin
                     if Present (Args)
                       and then Is_Entity_Name (Expression (First (Args)))
                       and then Is_Type (Entity (Expression (First (Args))))
                       and then Entity (Expression (First (Args))) /= E
                     then
                        return;
                     end if;
                  end;

               elsif Nkind (P) = N_Aspect_Specification
                 and then Is_Type (Entity (P))
                 and then Entity (P) /= E
               then
                  return;
               end if;
            end if;

            --  Here we have a definite duplicate

            Error_Msg_Name_1 := Pragma_Name (N);
            Error_Msg_Sloc := Sloc (P);

            --  For a single protected or a single task object, the error is
            --  issued on the original entity.

            if Ekind_In (Id, E_Task_Type, E_Protected_Type) then
               Id := Defining_Identifier (Original_Node (Parent (Id)));
            end if;

            if Nkind (P) = N_Aspect_Specification
              or else From_Aspect_Specification (P)
            then
               Error_Msg_NE ("aspect% for & previously given#", N, Id);
            else
               Error_Msg_NE ("pragma% for & duplicates pragma#", N, Id);
            end if;

            raise Pragma_Exit;
         end if;
      end Check_Duplicate_Pragma;

      ----------------------------------
      -- Check_Duplicated_Export_Name --
      ----------------------------------

      procedure Check_Duplicated_Export_Name (Nam : Node_Id) is
         String_Val : constant String_Id := Strval (Nam);

      begin
         --  We are only interested in the export case, and in the case of
         --  generics, it is the instance, not the template, that is the
         --  problem (the template will generate a warning in any case).

         if not Inside_A_Generic
           and then (Prag_Id = Pragma_Export
                       or else
                     Prag_Id = Pragma_Export_Procedure
                       or else
                     Prag_Id = Pragma_Export_Valued_Procedure
                       or else
                     Prag_Id = Pragma_Export_Function)
         then
            for J in Externals.First .. Externals.Last loop
               if String_Equal (String_Val, Strval (Externals.Table (J))) then
                  Error_Msg_Sloc := Sloc (Externals.Table (J));
                  Error_Msg_N ("external name duplicates name given#", Nam);
                  exit;
               end if;
            end loop;

            Externals.Append (Nam);
         end if;
      end Check_Duplicated_Export_Name;

      ----------------------------------------
      -- Check_Expr_Is_OK_Static_Expression --
      ----------------------------------------

      procedure Check_Expr_Is_OK_Static_Expression
        (Expr : Node_Id;
         Typ  : Entity_Id := Empty)
      is
      begin
         if Present (Typ) then
            Analyze_And_Resolve (Expr, Typ);
         else
            Analyze_And_Resolve (Expr);
         end if;

         --  An expression cannot be considered static if its resolution failed
         --  or if it's erroneous. Stop the analysis of the related pragma.

         if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
            raise Pragma_Exit;

         elsif Is_OK_Static_Expression (Expr) then
            return;

         --  An interesting special case, if we have a string literal and we
         --  are in Ada 83 mode, then we allow it even though it will not be
         --  flagged as static. This allows the use of Ada 95 pragmas like
         --  Import in Ada 83 mode. They will of course be flagged with
         --  warnings as usual, but will not cause errors.

         elsif Ada_Version = Ada_83
           and then Nkind (Expr) = N_String_Literal
         then
            return;

         --  Finally, we have a real error

         else
            Error_Msg_Name_1 := Pname;
            Flag_Non_Static_Expr
              (Fix_Error ("argument for pragma% must be a static expression!"),
               Expr);
            raise Pragma_Exit;
         end if;
      end Check_Expr_Is_OK_Static_Expression;

      -------------------------
      -- Check_First_Subtype --
      -------------------------

      procedure Check_First_Subtype (Arg : Node_Id) is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);
         Ent  : constant Entity_Id := Entity (Argx);

      begin
         if Is_First_Subtype (Ent) then
            null;

         elsif Is_Type (Ent) then
            Error_Pragma_Arg
              ("pragma% cannot apply to subtype", Argx);

         elsif Is_Object (Ent) then
            Error_Pragma_Arg
              ("pragma% cannot apply to object, requires a type", Argx);

         else
            Error_Pragma_Arg
              ("pragma% cannot apply to&, requires a type", Argx);
         end if;
      end Check_First_Subtype;

      ----------------------
      -- Check_Identifier --
      ----------------------

      procedure Check_Identifier (Arg : Node_Id; Id : Name_Id) is
      begin
         if Present (Arg)
           and then Nkind (Arg) = N_Pragma_Argument_Association
         then
            if Chars (Arg) = No_Name or else Chars (Arg) /= Id then
               Error_Msg_Name_1 := Pname;
               Error_Msg_Name_2 := Id;
               Error_Msg_N ("pragma% argument expects identifier%", Arg);
               raise Pragma_Exit;
            end if;
         end if;
      end Check_Identifier;

      --------------------------------
      -- Check_Identifier_Is_One_Of --
      --------------------------------

      procedure Check_Identifier_Is_One_Of (Arg : Node_Id; N1, N2 : Name_Id) is
      begin
         if Present (Arg)
           and then Nkind (Arg) = N_Pragma_Argument_Association
         then
            if Chars (Arg) = No_Name then
               Error_Msg_Name_1 := Pname;
               Error_Msg_N ("pragma% argument expects an identifier", Arg);
               raise Pragma_Exit;

            elsif Chars (Arg) /= N1
              and then Chars (Arg) /= N2
            then
               Error_Msg_Name_1 := Pname;
               Error_Msg_N ("invalid identifier for pragma% argument", Arg);
               raise Pragma_Exit;
            end if;
         end if;
      end Check_Identifier_Is_One_Of;

      ---------------------------
      -- Check_In_Main_Program --
      ---------------------------

      procedure Check_In_Main_Program is
         P : constant Node_Id := Parent (N);

      begin
         --  Must be in subprogram body

         if Nkind (P) /= N_Subprogram_Body then
            Error_Pragma ("% pragma allowed only in subprogram");

         --  Otherwise warn if obviously not main program

         elsif Present (Parameter_Specifications (Specification (P)))
           or else not Is_Compilation_Unit (Defining_Entity (P))
         then
            Error_Msg_Name_1 := Pname;
            Error_Msg_N
              ("??pragma% is only effective in main program", N);
         end if;
      end Check_In_Main_Program;

      ---------------------------------------
      -- Check_Interrupt_Or_Attach_Handler --
      ---------------------------------------

      procedure Check_Interrupt_Or_Attach_Handler is
         Arg1_X : constant Node_Id := Get_Pragma_Arg (Arg1);
         Handler_Proc, Proc_Scope : Entity_Id;

      begin
         Analyze (Arg1_X);

         if Prag_Id = Pragma_Interrupt_Handler then
            Check_Restriction (No_Dynamic_Attachment, N);
         end if;

         Handler_Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1);
         Proc_Scope := Scope (Handler_Proc);

         if Ekind (Proc_Scope) /= E_Protected_Type then
            Error_Pragma_Arg
              ("argument of pragma% must be protected procedure", Arg1);
         end if;

         --  For pragma case (as opposed to access case), check placement.
         --  We don't need to do that for aspects, because we have the
         --  check that they aspect applies an appropriate procedure.

         if not From_Aspect_Specification (N)
           and then Parent (N) /= Protected_Definition (Parent (Proc_Scope))
         then
            Error_Pragma ("pragma% must be in protected definition");
         end if;

         if not Is_Library_Level_Entity (Proc_Scope) then
            Error_Pragma_Arg
              ("argument for pragma% must be library level entity", Arg1);
         end if;

         --  AI05-0033: A pragma cannot appear within a generic body, because
         --  instance can be in a nested scope. The check that protected type
         --  is itself a library-level declaration is done elsewhere.

         --  Note: we omit this check in Relaxed_RM_Semantics mode to properly
         --  handle code prior to AI-0033. Analysis tools typically are not
         --  interested in this pragma in any case, so no need to worry too
         --  much about its placement.

         if Inside_A_Generic then
            if Ekind (Scope (Current_Scope)) = E_Generic_Package
              and then In_Package_Body (Scope (Current_Scope))
              and then not Relaxed_RM_Semantics
            then
               Error_Pragma ("pragma% cannot be used inside a generic");
            end if;
         end if;
      end Check_Interrupt_Or_Attach_Handler;

      ---------------------------------
      -- Check_Loop_Pragma_Placement --
      ---------------------------------

      procedure Check_Loop_Pragma_Placement is
         procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id);
         --  Verify whether the current pragma is properly grouped with other
         --  pragma Loop_Invariant and/or Loop_Variant. Node Loop_Stmt is the
         --  related loop where the pragma appears.

         function Is_Loop_Pragma (Stmt : Node_Id) return Boolean;
         --  Determine whether an arbitrary statement Stmt denotes pragma
         --  Loop_Invariant or Loop_Variant.

         procedure Placement_Error (Constr : Node_Id);
         pragma No_Return (Placement_Error);
         --  Node Constr denotes the last loop restricted construct before we
         --  encountered an illegal relation between enclosing constructs. Emit
         --  an error depending on what Constr was.

         --------------------------------
         -- Check_Loop_Pragma_Grouping --
         --------------------------------

         procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id) is
            Stop_Search : exception;
            --  This exception is used to terminate the recursive descent of
            --  routine Check_Grouping.

            procedure Check_Grouping (L : List_Id);
            --  Find the first group of pragmas in list L and if successful,
            --  ensure that the current pragma is part of that group. The
            --  routine raises Stop_Search once such a check is performed to
            --  halt the recursive descent.

            procedure Grouping_Error (Prag : Node_Id);
            pragma No_Return (Grouping_Error);
            --  Emit an error concerning the current pragma indicating that it
            --  should be placed after pragma Prag.

            --------------------
            -- Check_Grouping --
            --------------------

            procedure Check_Grouping (L : List_Id) is
               HSS  : Node_Id;
               Stmt : Node_Id;
               Prag : Node_Id := Empty; -- init to avoid warning

            begin
               --  Inspect the list of declarations or statements looking for
               --  the first grouping of pragmas:

               --    loop
               --       pragma Loop_Invariant ...;
               --       pragma Loop_Variant ...;
               --       . . .                     -- (1)
               --       pragma Loop_Variant ...;  --  current pragma

               --  If the current pragma is not in the grouping, then it must
               --  either appear in a different declarative or statement list
               --  or the construct at (1) is separating the pragma from the
               --  grouping.

               Stmt := First (L);
               while Present (Stmt) loop

                  --  First pragma of the first topmost grouping has been found

                  if Is_Loop_Pragma (Stmt) then

                     --  The group and the current pragma are not in the same
                     --  declarative or statement list.

                     if List_Containing (Stmt) /= List_Containing (N) then
                        Grouping_Error (Stmt);

                     --  Try to reach the current pragma from the first pragma
                     --  of the grouping while skipping other members:

                     --    pragma Loop_Invariant ...;  --  first pragma
                     --    pragma Loop_Variant ...;    --  member
                     --    . . .
                     --    pragma Loop_Variant ...;    --  current pragma

                     else
                        while Present (Stmt) loop
                           --  The current pragma is either the first pragma
                           --  of the group or is a member of the group.
                           --  Stop the search as the placement is legal.

                           if Stmt = N then
                              raise Stop_Search;

                           --  Skip group members, but keep track of the
                           --  last pragma in the group.

                           elsif Is_Loop_Pragma (Stmt) then
                              Prag := Stmt;

                           --  Skip declarations and statements generated by
                           --  the compiler during expansion. Note that some
                           --  source statements (e.g. pragma Assert) may have
                           --  been transformed so that they do not appear as
                           --  coming from source anymore, so we instead look
                           --  at their Original_Node.

                           elsif not Comes_From_Source (Original_Node (Stmt))
                           then
                              null;

                           --  A non-pragma is separating the group from the
                           --  current pragma, the placement is illegal.

                           else
                              Grouping_Error (Prag);
                           end if;

                           Next (Stmt);
                        end loop;

                        --  If the traversal did not reach the current pragma,
                        --  then the list must be malformed.

                        raise Program_Error;
                     end if;

                  --  Pragmas Loop_Invariant and Loop_Variant may only appear
                  --  inside a loop or a block housed inside a loop. Inspect
                  --  the declarations and statements of the block as they may
                  --  contain the first grouping. This case follows the one for
                  --  loop pragmas, as block statements which originate in a
                  --  loop pragma (and so Is_Loop_Pragma will return True on
                  --  that block statement) should be treated in the previous
                  --  case.

                  elsif Nkind (Stmt) = N_Block_Statement then
                     HSS := Handled_Statement_Sequence (Stmt);

                     Check_Grouping (Declarations (Stmt));

                     if Present (HSS) then
                        Check_Grouping (Statements (HSS));
                     end if;
                  end if;

                  Next (Stmt);
               end loop;
            end Check_Grouping;

            --------------------
            -- Grouping_Error --
            --------------------

            procedure Grouping_Error (Prag : Node_Id) is
            begin
               Error_Msg_Sloc := Sloc (Prag);
               Error_Pragma ("pragma% must appear next to pragma#");
            end Grouping_Error;

         --  Start of processing for Check_Loop_Pragma_Grouping

         begin
            --  Inspect the statements of the loop or nested blocks housed
            --  within to determine whether the current pragma is part of the
            --  first topmost grouping of Loop_Invariant and Loop_Variant.

            Check_Grouping (Statements (Loop_Stmt));

         exception
            when Stop_Search => null;
         end Check_Loop_Pragma_Grouping;

         --------------------
         -- Is_Loop_Pragma --
         --------------------

         function Is_Loop_Pragma (Stmt : Node_Id) return Boolean is
         begin
            --  Inspect the original node as Loop_Invariant and Loop_Variant
            --  pragmas are rewritten to null when assertions are disabled.

            if Nkind (Original_Node (Stmt)) = N_Pragma then
               return
                 Nam_In (Pragma_Name_Unmapped (Original_Node (Stmt)),
                         Name_Loop_Invariant,
                         Name_Loop_Variant);
            else
               return False;
            end if;
         end Is_Loop_Pragma;

         ---------------------
         -- Placement_Error --
         ---------------------

         procedure Placement_Error (Constr : Node_Id) is
            LA : constant String := " with Loop_Entry";

         begin
            if Prag_Id = Pragma_Assert then
               Error_Msg_String (1 .. LA'Length) := LA;
               Error_Msg_Strlen := LA'Length;
            else
               Error_Msg_Strlen := 0;
            end if;

            if Nkind (Constr) = N_Pragma then
               Error_Pragma
                 ("pragma %~ must appear immediately within the statements "
                  & "of a loop");
            else
               Error_Pragma_Arg
                 ("block containing pragma %~ must appear immediately within "
                  & "the statements of a loop", Constr);
            end if;
         end Placement_Error;

         --  Local declarations

         Prev : Node_Id;
         Stmt : Node_Id;

      --  Start of processing for Check_Loop_Pragma_Placement

      begin
         --  Check that pragma appears immediately within a loop statement,
         --  ignoring intervening block statements.

         Prev := N;
         Stmt := Parent (N);
         while Present (Stmt) loop

            --  The pragma or previous block must appear immediately within the
            --  current block's declarative or statement part.

            if Nkind (Stmt) = N_Block_Statement then
               if (No (Declarations (Stmt))
                    or else List_Containing (Prev) /= Declarations (Stmt))
                 and then
                   List_Containing (Prev) /=
                     Statements (Handled_Statement_Sequence (Stmt))
               then
                  Placement_Error (Prev);
                  return;

               --  Keep inspecting the parents because we are now within a
               --  chain of nested blocks.

               else
                  Prev := Stmt;
                  Stmt := Parent (Stmt);
               end if;

            --  The pragma or previous block must appear immediately within the
            --  statements of the loop.

            elsif Nkind (Stmt) = N_Loop_Statement then
               if List_Containing (Prev) /= Statements (Stmt) then
                  Placement_Error (Prev);
               end if;

               --  Stop the traversal because we reached the innermost loop
               --  regardless of whether we encountered an error or not.

               exit;

            --  Ignore a handled statement sequence. Note that this node may
            --  be related to a subprogram body in which case we will emit an
            --  error on the next iteration of the search.

            elsif Nkind (Stmt) = N_Handled_Sequence_Of_Statements then
               Stmt := Parent (Stmt);

            --  Any other statement breaks the chain from the pragma to the
            --  loop.

            else
               Placement_Error (Prev);
               return;
            end if;
         end loop;

         --  Check that the current pragma Loop_Invariant or Loop_Variant is
         --  grouped together with other such pragmas.

         if Is_Loop_Pragma (N) then

            --  The previous check should have located the related loop

            pragma Assert (Nkind (Stmt) = N_Loop_Statement);
            Check_Loop_Pragma_Grouping (Stmt);
         end if;
      end Check_Loop_Pragma_Placement;

      -------------------------------------------
      -- Check_Is_In_Decl_Part_Or_Package_Spec --
      -------------------------------------------

      procedure Check_Is_In_Decl_Part_Or_Package_Spec is
         P : Node_Id;

      begin
         P := Parent (N);
         loop
            if No (P) then
               exit;

            elsif Nkind (P) = N_Handled_Sequence_Of_Statements then
               exit;

            elsif Nkind_In (P, N_Package_Specification,
                               N_Block_Statement)
            then
               return;

            --  Note: the following tests seem a little peculiar, because
            --  they test for bodies, but if we were in the statement part
            --  of the body, we would already have hit the handled statement
            --  sequence, so the only way we get here is by being in the
            --  declarative part of the body.

            elsif Nkind_In (P, N_Subprogram_Body,
                               N_Package_Body,
                               N_Task_Body,
                               N_Entry_Body)
            then
               return;
            end if;

            P := Parent (P);
         end loop;

         Error_Pragma ("pragma% is not in declarative part or package spec");
      end Check_Is_In_Decl_Part_Or_Package_Spec;

      -------------------------
      -- Check_No_Identifier --
      -------------------------

      procedure Check_No_Identifier (Arg : Node_Id) is
      begin
         if Nkind (Arg) = N_Pragma_Argument_Association
           and then Chars (Arg) /= No_Name
         then
            Error_Pragma_Arg_Ident
              ("pragma% does not permit identifier& here", Arg);
         end if;
      end Check_No_Identifier;

      --------------------------
      -- Check_No_Identifiers --
      --------------------------

      procedure Check_No_Identifiers is
         Arg_Node : Node_Id;
      begin
         Arg_Node := Arg1;
         for J in 1 .. Arg_Count loop
            Check_No_Identifier (Arg_Node);
            Next (Arg_Node);
         end loop;
      end Check_No_Identifiers;

      ------------------------
      -- Check_No_Link_Name --
      ------------------------

      procedure Check_No_Link_Name is
      begin
         if Present (Arg3) and then Chars (Arg3) = Name_Link_Name then
            Arg4 := Arg3;
         end if;

         if Present (Arg4) then
            Error_Pragma_Arg
              ("Link_Name argument not allowed for Import Intrinsic", Arg4);
         end if;
      end Check_No_Link_Name;

      -------------------------------
      -- Check_Optional_Identifier --
      -------------------------------

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : Name_Id) is
      begin
         if Present (Arg)
           and then Nkind (Arg) = N_Pragma_Argument_Association
           and then Chars (Arg) /= No_Name
         then
            if Chars (Arg) /= Id then
               Error_Msg_Name_1 := Pname;
               Error_Msg_Name_2 := Id;
               Error_Msg_N ("pragma% argument expects identifier%", Arg);
               raise Pragma_Exit;
            end if;
         end if;
      end Check_Optional_Identifier;

      procedure Check_Optional_Identifier (Arg : Node_Id; Id : String) is
      begin
         Check_Optional_Identifier (Arg, Name_Find (Id));
      end Check_Optional_Identifier;

      -------------------------------------
      -- Check_Static_Boolean_Expression --
      -------------------------------------

      procedure Check_Static_Boolean_Expression (Expr : Node_Id) is
      begin
         if Present (Expr) then
            Analyze_And_Resolve (Expr, Standard_Boolean);

            if not Is_OK_Static_Expression (Expr) then
               Error_Pragma_Arg
                 ("expression of pragma % must be static", Expr);
            end if;
         end if;
      end Check_Static_Boolean_Expression;

      -----------------------------
      -- Check_Static_Constraint --
      -----------------------------

      --  Note: for convenience in writing this procedure, in addition to
      --  the officially (i.e. by spec) allowed argument which is always a
      --  constraint, it also allows ranges and discriminant associations.
      --  Above is not clear ???

      procedure Check_Static_Constraint (Constr : Node_Id) is

         procedure Require_Static (E : Node_Id);
         --  Require given expression to be static expression

         --------------------
         -- Require_Static --
         --------------------

         procedure Require_Static (E : Node_Id) is
         begin
            if not Is_OK_Static_Expression (E) then
               Flag_Non_Static_Expr
                 ("non-static constraint not allowed in Unchecked_Union!", E);
               raise Pragma_Exit;
            end if;
         end Require_Static;

      --  Start of processing for Check_Static_Constraint

      begin
         case Nkind (Constr) is
            when N_Discriminant_Association =>
               Require_Static (Expression (Constr));

            when N_Range =>
               Require_Static (Low_Bound (Constr));
               Require_Static (High_Bound (Constr));

            when N_Attribute_Reference =>
               Require_Static (Type_Low_Bound  (Etype (Prefix (Constr))));
               Require_Static (Type_High_Bound (Etype (Prefix (Constr))));

            when N_Range_Constraint =>
               Check_Static_Constraint (Range_Expression (Constr));

            when N_Index_Or_Discriminant_Constraint =>
               declare
                  IDC : Entity_Id;
               begin
                  IDC := First (Constraints (Constr));
                  while Present (IDC) loop
                     Check_Static_Constraint (IDC);
                     Next (IDC);
                  end loop;
               end;

            when others =>
               null;
         end case;
      end Check_Static_Constraint;

      --------------------------------------
      -- Check_Valid_Configuration_Pragma --
      --------------------------------------

      --  A configuration pragma must appear in the context clause of a
      --  compilation unit, and only other pragmas may precede it. Note that
      --  the test also allows use in a configuration pragma file.

      procedure Check_Valid_Configuration_Pragma is
      begin
         if not Is_Configuration_Pragma then
            Error_Pragma ("incorrect placement for configuration pragma%");
         end if;
      end Check_Valid_Configuration_Pragma;

      -------------------------------------
      -- Check_Valid_Library_Unit_Pragma --
      -------------------------------------

      procedure Check_Valid_Library_Unit_Pragma is
         Plist       : List_Id;
         Parent_Node : Node_Id;
         Unit_Name   : Entity_Id;
         Unit_Kind   : Node_Kind;
         Unit_Node   : Node_Id;
         Sindex      : Source_File_Index;

      begin
         if not Is_List_Member (N) then
            Pragma_Misplaced;

         else
            Plist := List_Containing (N);
            Parent_Node := Parent (Plist);

            if Parent_Node = Empty then
               Pragma_Misplaced;

            --  Case of pragma appearing after a compilation unit. In this case
            --  it must have an argument with the corresponding name and must
            --  be part of the following pragmas of its parent.

            elsif Nkind (Parent_Node) = N_Compilation_Unit_Aux then
               if Plist /= Pragmas_After (Parent_Node) then
                  Pragma_Misplaced;

               elsif Arg_Count = 0 then
                  Error_Pragma
                    ("argument required if outside compilation unit");

               else
                  Check_No_Identifiers;
                  Check_Arg_Count (1);
                  Unit_Node := Unit (Parent (Parent_Node));
                  Unit_Kind := Nkind (Unit_Node);

                  Analyze (Get_Pragma_Arg (Arg1));

                  if Unit_Kind = N_Generic_Subprogram_Declaration
                    or else Unit_Kind = N_Subprogram_Declaration
                  then
                     Unit_Name := Defining_Entity (Unit_Node);

                  elsif Unit_Kind in N_Generic_Instantiation then
                     Unit_Name := Defining_Entity (Unit_Node);

                  else
                     Unit_Name := Cunit_Entity (Current_Sem_Unit);
                  end if;

                  if Chars (Unit_Name) /=
                     Chars (Entity (Get_Pragma_Arg (Arg1)))
                  then
                     Error_Pragma_Arg
                       ("pragma% argument is not current unit name", Arg1);
                  end if;

                  if Ekind (Unit_Name) = E_Package
                    and then Present (Renamed_Entity (Unit_Name))
                  then
                     Error_Pragma ("pragma% not allowed for renamed package");
                  end if;
               end if;

            --  Pragma appears other than after a compilation unit

            else
               --  Here we check for the generic instantiation case and also
               --  for the case of processing a generic formal package. We
               --  detect these cases by noting that the Sloc on the node
               --  does not belong to the current compilation unit.

               Sindex := Source_Index (Current_Sem_Unit);

               if Loc not in Source_First (Sindex) .. Source_Last (Sindex) then
                  Rewrite (N, Make_Null_Statement (Loc));
                  return;

               --  If before first declaration, the pragma applies to the
               --  enclosing unit, and the name if present must be this name.

               elsif Is_Before_First_Decl (N, Plist) then
                  Unit_Node := Unit_Declaration_Node (Current_Scope);
                  Unit_Kind := Nkind (Unit_Node);

                  if Nkind (Parent (Unit_Node)) /= N_Compilation_Unit then
                     Pragma_Misplaced;

                  elsif Unit_Kind = N_Subprogram_Body
                    and then not Acts_As_Spec (Unit_Node)
                  then
                     Pragma_Misplaced;

                  elsif Nkind (Parent_Node) = N_Package_Body then
                     Pragma_Misplaced;

                  elsif Nkind (Parent_Node) = N_Package_Specification
                    and then Plist = Private_Declarations (Parent_Node)
                  then
                     Pragma_Misplaced;

                  elsif (Nkind (Parent_Node) = N_Generic_Package_Declaration
                          or else Nkind (Parent_Node) =
                                             N_Generic_Subprogram_Declaration)
                    and then Plist = Generic_Formal_Declarations (Parent_Node)
                  then
                     Pragma_Misplaced;

                  elsif Arg_Count > 0 then
                     Analyze (Get_Pragma_Arg (Arg1));

                     if Entity (Get_Pragma_Arg (Arg1)) /= Current_Scope then
                        Error_Pragma_Arg
                          ("name in pragma% must be enclosing unit", Arg1);
                     end if;

                  --  It is legal to have no argument in this context

                  else
                     return;
                  end if;

               --  Error if not before first declaration. This is because a
               --  library unit pragma argument must be the name of a library
               --  unit (RM 10.1.5(7)), but the only names permitted in this
               --  context are (RM 10.1.5(6)) names of subprogram declarations,
               --  generic subprogram declarations or generic instantiations.

               else
                  Error_Pragma
                    ("pragma% misplaced, must be before first declaration");
               end if;
            end if;
         end if;
      end Check_Valid_Library_Unit_Pragma;

      -------------------
      -- Check_Variant --
      -------------------

      procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id) is
         Clist : constant Node_Id := Component_List (Variant);
         Comp  : Node_Id;

      begin
         Comp := First_Non_Pragma (Component_Items (Clist));
         while Present (Comp) loop
            Check_Component (Comp, UU_Typ, In_Variant_Part => True);
            Next_Non_Pragma (Comp);
         end loop;
      end Check_Variant;

      ---------------------------
      -- Ensure_Aggregate_Form --
      ---------------------------

      procedure Ensure_Aggregate_Form (Arg : Node_Id) is
         CFSD    : constant Boolean    := Get_Comes_From_Source_Default;
         Expr    : constant Node_Id    := Expression (Arg);
         Loc     : constant Source_Ptr := Sloc (Expr);
         Comps   : List_Id := No_List;
         Exprs   : List_Id := No_List;
         Nam     : Name_Id := No_Name;
         Nam_Loc : Source_Ptr;

      begin
         --  The pragma argument is in positional form:

         --    pragma Depends (Nam => ...)
         --                    ^
         --                    Chars field

         --  Note that the Sloc of the Chars field is the Sloc of the pragma
         --  argument association.

         if Nkind (Arg) = N_Pragma_Argument_Association then
            Nam     := Chars (Arg);
            Nam_Loc := Sloc (Arg);

            --  Remove the pragma argument name as this will be captured in the
            --  aggregate.

            Set_Chars (Arg, No_Name);
         end if;

         --  The argument is already in aggregate form, but the presence of a
         --  name causes this to be interpreted as named association which in
         --  turn must be converted into an aggregate.

         --    pragma Global (In_Out => (A, B, C))
         --                   ^         ^
         --                   name      aggregate

         --    pragma Global ((In_Out => (A, B, C)))
         --                   ^          ^
         --                   aggregate  aggregate

         if Nkind (Expr) = N_Aggregate then
            if Nam = No_Name then
               return;
            end if;

         --  Do not transform a null argument into an aggregate as N_Null has
         --  special meaning in formal verification pragmas.

         elsif Nkind (Expr) = N_Null then
            return;
         end if;

         --  Everything comes from source if the original comes from source

         Set_Comes_From_Source_Default (Comes_From_Source (Arg));

         --  Positional argument is transformed into an aggregate with an
         --  Expressions list.

         if Nam = No_Name then
            Exprs := New_List (Relocate_Node (Expr));

         --  An associative argument is transformed into an aggregate with
         --  Component_Associations.

         else
            Comps := New_List (
              Make_Component_Association (Loc,
                Choices    => New_List (Make_Identifier (Nam_Loc, Nam)),
                Expression => Relocate_Node (Expr)));
         end if;

         Set_Expression (Arg,
           Make_Aggregate (Loc,
             Component_Associations => Comps,
             Expressions            => Exprs));

         --  Restore Comes_From_Source default

         Set_Comes_From_Source_Default (CFSD);
      end Ensure_Aggregate_Form;

      ------------------
      -- Error_Pragma --
      ------------------

      procedure Error_Pragma (Msg : String) is
      begin
         Error_Msg_Name_1 := Pname;
         Error_Msg_N (Fix_Error (Msg), N);
         raise Pragma_Exit;
      end Error_Pragma;

      ----------------------
      -- Error_Pragma_Arg --
      ----------------------

      procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id) is
      begin
         Error_Msg_Name_1 := Pname;
         Error_Msg_N (Fix_Error (Msg), Get_Pragma_Arg (Arg));
         raise Pragma_Exit;
      end Error_Pragma_Arg;

      procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id) is
      begin
         Error_Msg_Name_1 := Pname;
         Error_Msg_N (Fix_Error (Msg1), Get_Pragma_Arg (Arg));
         Error_Pragma_Arg (Msg2, Arg);
      end Error_Pragma_Arg;

      ----------------------------
      -- Error_Pragma_Arg_Ident --
      ----------------------------

      procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id) is
      begin
         Error_Msg_Name_1 := Pname;
         Error_Msg_N (Fix_Error (Msg), Arg);
         raise Pragma_Exit;
      end Error_Pragma_Arg_Ident;

      ----------------------
      -- Error_Pragma_Ref --
      ----------------------

      procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id) is
      begin
         Error_Msg_Name_1 := Pname;
         Error_Msg_Sloc := Sloc (Ref);
         Error_Msg_NE (Fix_Error (Msg), N, Ref);
         raise Pragma_Exit;
      end Error_Pragma_Ref;

      ------------------------
      -- Find_Lib_Unit_Name --
      ------------------------

      function Find_Lib_Unit_Name return Entity_Id is
      begin
         --  Return inner compilation unit entity, for case of nested
         --  categorization pragmas. This happens in generic unit.

         if Nkind (Parent (N)) = N_Package_Specification
           and then Defining_Entity (Parent (N)) /= Current_Scope
         then
            return Defining_Entity (Parent (N));
         else
            return Current_Scope;
         end if;
      end Find_Lib_Unit_Name;

      ----------------------------
      -- Find_Program_Unit_Name --
      ----------------------------

      procedure Find_Program_Unit_Name (Id : Node_Id) is
         Unit_Name : Entity_Id;
         Unit_Kind : Node_Kind;
         P         : constant Node_Id := Parent (N);

      begin
         if Nkind (P) = N_Compilation_Unit then
            Unit_Kind := Nkind (Unit (P));

            if Nkind_In (Unit_Kind, N_Subprogram_Declaration,
                                    N_Package_Declaration)
              or else Unit_Kind in N_Generic_Declaration
            then
               Unit_Name := Defining_Entity (Unit (P));

               if Chars (Id) = Chars (Unit_Name) then
                  Set_Entity (Id, Unit_Name);
                  Set_Etype (Id, Etype (Unit_Name));
               else
                  Set_Etype (Id, Any_Type);
                  Error_Pragma
                    ("cannot find program unit referenced by pragma%");
               end if;

            else
               Set_Etype (Id, Any_Type);
               Error_Pragma ("pragma% inapplicable to this unit");
            end if;

         else
            Analyze (Id);
         end if;
      end Find_Program_Unit_Name;

      -----------------------------------------
      -- Find_Unique_Parameterless_Procedure --
      -----------------------------------------

      function Find_Unique_Parameterless_Procedure
        (Name : Entity_Id;
         Arg  : Node_Id) return Entity_Id
      is
         Proc : Entity_Id := Empty;

      begin
         --  The body of this procedure needs some comments ???

         if not Is_Entity_Name (Name) then
            Error_Pragma_Arg
              ("argument of pragma% must be entity name", Arg);

         elsif not Is_Overloaded (Name) then
            Proc := Entity (Name);

            if Ekind (Proc) /= E_Procedure
              or else Present (First_Formal (Proc))
            then
               Error_Pragma_Arg
                 ("argument of pragma% must be parameterless procedure", Arg);
            end if;

         else
            declare
               Found : Boolean := False;
               It    : Interp;
               Index : Interp_Index;

            begin
               Get_First_Interp (Name, Index, It);
               while Present (It.Nam) loop
                  Proc := It.Nam;

                  if Ekind (Proc) = E_Procedure
                    and then No (First_Formal (Proc))
                  then
                     if not Found then
                        Found := True;
                        Set_Entity (Name, Proc);
                        Set_Is_Overloaded (Name, False);
                     else
                        Error_Pragma_Arg
                          ("ambiguous handler name for pragma% ", Arg);
                     end if;
                  end if;

                  Get_Next_Interp (Index, It);
               end loop;

               if not Found then
                  Error_Pragma_Arg
                    ("argument of pragma% must be parameterless procedure",
                     Arg);
               else
                  Proc := Entity (Name);
               end if;
            end;
         end if;

         return Proc;
      end Find_Unique_Parameterless_Procedure;

      ---------------
      -- Fix_Error --
      ---------------

      function Fix_Error (Msg : String) return String is
         Res      : String (Msg'Range) := Msg;
         Res_Last : Natural            := Msg'Last;
         J        : Natural;

      begin
         --  If we have a rewriting of another pragma, go to that pragma

         if Is_Rewrite_Substitution (N)
           and then Nkind (Original_Node (N)) = N_Pragma
         then
            Error_Msg_Name_1 := Pragma_Name (Original_Node (N));
         end if;

         --  Case where pragma comes from an aspect specification

         if From_Aspect_Specification (N) then

            --  Change appearence of "pragma" in message to "aspect"

            J := Res'First;
            while J <= Res_Last - 5 loop
               if Res (J .. J + 5) = "pragma" then
                  Res (J .. J + 5) := "aspect";
                  J := J + 6;

               else
                  J := J + 1;
               end if;
            end loop;

            --  Change "argument of" at start of message to "entity for"

            if Res'Length > 11
              and then Res (Res'First .. Res'First + 10) = "argument of"
            then
               Res (Res'First .. Res'First + 9) := "entity for";
               Res (Res'First + 10 .. Res_Last - 1) :=
                 Res (Res'First + 11 .. Res_Last);
               Res_Last := Res_Last - 1;
            end if;

            --  Change "argument" at start of message to "entity"

            if Res'Length > 8
              and then Res (Res'First .. Res'First + 7) = "argument"
            then
               Res (Res'First .. Res'First + 5) := "entity";
               Res (Res'First + 6 .. Res_Last - 2) :=
                 Res (Res'First + 8 .. Res_Last);
               Res_Last := Res_Last - 2;
            end if;

            --  Get name from corresponding aspect

            Error_Msg_Name_1 := Original_Aspect_Pragma_Name (N);
         end if;

         --  Return possibly modified message

         return Res (Res'First .. Res_Last);
      end Fix_Error;

      -------------------------
      -- Gather_Associations --
      -------------------------

      procedure Gather_Associations
        (Names : Name_List;
         Args  : out Args_List)
      is
         Arg : Node_Id;

      begin
         --  Initialize all parameters to Empty

         for J in Args'Range loop
            Args (J) := Empty;
         end loop;

         --  That's all we have to do if there are no argument associations

         if No (Pragma_Argument_Associations (N)) then
            return;
         end if;

         --  Otherwise first deal with any positional parameters present

         Arg := First (Pragma_Argument_Associations (N));
         for Index in Args'Range loop
            exit when No (Arg) or else Chars (Arg) /= No_Name;
            Args (Index) := Get_Pragma_Arg (Arg);
            Next (Arg);
         end loop;

         --  Positional parameters all processed, if any left, then we
         --  have too many positional parameters.

         if Present (Arg) and then Chars (Arg) = No_Name then
            Error_Pragma_Arg
              ("too many positional associations for pragma%", Arg);
         end if;

         --  Process named parameters if any are present

         while Present (Arg) loop
            if Chars (Arg) = No_Name then
               Error_Pragma_Arg
                 ("positional association cannot follow named association",
                  Arg);

            else
               for Index in Names'Range loop
                  if Names (Index) = Chars (Arg) then
                     if Present (Args (Index)) then
                        Error_Pragma_Arg
                          ("duplicate argument association for pragma%", Arg);
                     else
                        Args (Index) := Get_Pragma_Arg (Arg);
                        exit;
                     end if;
                  end if;

                  if Index = Names'Last then
                     Error_Msg_Name_1 := Pname;
                     Error_Msg_N ("pragma% does not allow & argument", Arg);

                     --  Check for possible misspelling

                     for Index1 in Names'Range loop
                        if Is_Bad_Spelling_Of
                             (Chars (Arg), Names (Index1))
                        then
                           Error_Msg_Name_1 := Names (Index1);
                           Error_Msg_N -- CODEFIX
                             ("\possible misspelling of%", Arg);
                           exit;
                        end if;
                     end loop;

                     raise Pragma_Exit;
                  end if;
               end loop;
            end if;

            Next (Arg);
         end loop;
      end Gather_Associations;

      -----------------
      -- GNAT_Pragma --
      -----------------

      procedure GNAT_Pragma is
      begin
         --  We need to check the No_Implementation_Pragmas restriction for
         --  the case of a pragma from source. Note that the case of aspects
         --  generating corresponding pragmas marks these pragmas as not being
         --  from source, so this test also catches that case.

         if Comes_From_Source (N) then
            Check_Restriction (No_Implementation_Pragmas, N);
         end if;
      end GNAT_Pragma;

      --------------------------
      -- Is_Before_First_Decl --
      --------------------------

      function Is_Before_First_Decl
        (Pragma_Node : Node_Id;
         Decls       : List_Id) return Boolean
      is
         Item : Node_Id := First (Decls);

      begin
         --  Only other pragmas can come before this pragma

         loop
            if No (Item) or else Nkind (Item) /= N_Pragma then
               return False;

            elsif Item = Pragma_Node then
               return True;
            end if;

            Next (Item);
         end loop;
      end Is_Before_First_Decl;

      -----------------------------
      -- Is_Configuration_Pragma --
      -----------------------------

      --  A configuration pragma must appear in the context clause of a
      --  compilation unit, and only other pragmas may precede it. Note that
      --  the test below also permits use in a configuration pragma file.

      function Is_Configuration_Pragma return Boolean is
         Lis : constant List_Id := List_Containing (N);
         Par : constant Node_Id := Parent (N);
         Prg : Node_Id;

      begin
         --  If no parent, then we are in the configuration pragma file,
         --  so the placement is definitely appropriate.

         if No (Par) then
            return True;

         --  Otherwise we must be in the context clause of a compilation unit
         --  and the only thing allowed before us in the context list is more
         --  configuration pragmas.

         elsif Nkind (Par) = N_Compilation_Unit
           and then Context_Items (Par) = Lis
         then
            Prg := First (Lis);

            loop
               if Prg = N then
                  return True;
               elsif Nkind (Prg) /= N_Pragma then
                  return False;
               end if;

               Next (Prg);
            end loop;

         else
            return False;
         end if;
      end Is_Configuration_Pragma;

      --------------------------
      -- Is_In_Context_Clause --
      --------------------------

      function Is_In_Context_Clause return Boolean is
         Plist       : List_Id;
         Parent_Node : Node_Id;

      begin
         if not Is_List_Member (N) then
            return False;

         else
            Plist := List_Containing (N);
            Parent_Node := Parent (Plist);

            if Parent_Node = Empty
              or else Nkind (Parent_Node) /= N_Compilation_Unit
              or else Context_Items (Parent_Node) /= Plist
            then
               return False;
            end if;
         end if;

         return True;
      end Is_In_Context_Clause;

      ---------------------------------
      -- Is_Static_String_Expression --
      ---------------------------------

      function Is_Static_String_Expression (Arg : Node_Id) return Boolean is
         Argx : constant Node_Id := Get_Pragma_Arg (Arg);
         Lit  : constant Boolean := Nkind (Argx) = N_String_Literal;

      begin
         Analyze_And_Resolve (Argx);

         --  Special case Ada 83, where the expression will never be static,
         --  but we will return true if we had a string literal to start with.

         if Ada_Version = Ada_83 then
            return Lit;

         --  Normal case, true only if we end up with a string literal that
         --  is marked as being the result of evaluating a static expression.

         else
            return Is_OK_Static_Expression (Argx)
              and then Nkind (Argx) = N_String_Literal;
         end if;

      end Is_Static_String_Expression;

      ----------------------
      -- Pragma_Misplaced --
      ----------------------

      procedure Pragma_Misplaced is
      begin
         Error_Pragma ("incorrect placement of pragma%");
      end Pragma_Misplaced;

      ------------------------------------------------
      -- Process_Atomic_Independent_Shared_Volatile --
      ------------------------------------------------

      procedure Process_Atomic_Independent_Shared_Volatile is
         procedure Check_VFA_Conflicts (Ent : Entity_Id);
         --  Apply additional checks for the GNAT pragma Volatile_Full_Access

         procedure Mark_Component_Or_Object (Ent : Entity_Id);
         --  Appropriately set flags on the given entity (either an array or
         --  record component, or an object declaration) according to the
         --  current pragma.

         procedure Set_Atomic_VFA (Ent : Entity_Id);
         --  Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if
         --  no explicit alignment was given, set alignment to unknown, since
         --  back end knows what the alignment requirements are for atomic and
         --  full access arrays. Note: this is necessary for derived types.

         -------------------------
         -- Check_VFA_Conflicts --
         -------------------------

         procedure Check_VFA_Conflicts (Ent : Entity_Id) is
            Comp : Entity_Id;
            Typ  : Entity_Id;

            VFA_And_Atomic : Boolean := False;
            --  Set True if atomic component present

            VFA_And_Aliased : Boolean := False;
            --  Set True if aliased component present

         begin
            --  Fetch the type in case we are dealing with an object or
            --  component.

            if Is_Type (Ent) then
               Typ := Ent;
            else
               pragma Assert (Is_Object (Ent)
                 or else
                   Nkind (Declaration_Node (Ent)) = N_Component_Declaration);

               Typ := Etype (Ent);
            end if;

            --  Check Atomic and VFA used together

            if Prag_Id = Pragma_Volatile_Full_Access
              or else Is_Volatile_Full_Access (Ent)
            then
               if Prag_Id = Pragma_Atomic
                 or else Prag_Id = Pragma_Shared
                 or else Is_Atomic (Ent)
               then
                  VFA_And_Atomic := True;

               elsif Is_Array_Type (Typ) then
                  VFA_And_Atomic := Has_Atomic_Components (Typ);

               --  Note: Has_Atomic_Components is not used below, as this flag
               --  represents the pragma of the same name, Atomic_Components,
               --  which only applies to arrays.

               elsif Is_Record_Type (Typ) then
                  --  Attributes cannot be applied to discriminants, only
                  --  regular record components.

                  Comp := First_Component (Typ);
                  while Present (Comp) loop
                     if Is_Atomic (Comp)
                       or else Is_Atomic (Typ)
                     then
                        VFA_And_Atomic := True;

                        exit;
                     end if;

                     Next_Component (Comp);
                  end loop;
               end if;

               if VFA_And_Atomic then
                  Error_Pragma
                    ("cannot have Volatile_Full_Access and Atomic for same "
                     & "entity");
               end if;
            end if;

            --  Check for the application of VFA to an entity that has aliased
            --  components.

            if Prag_Id = Pragma_Volatile_Full_Access then
               if Is_Array_Type (Typ)
                 and then Has_Aliased_Components (Typ)
               then
                  VFA_And_Aliased := True;

               --  Note: Has_Aliased_Components, like Has_Atomic_Components,
               --  and Has_Independent_Components, applies only to arrays.
               --  However, this flag does not have a corresponding pragma, so
               --  perhaps it should be possible to apply it to record types as
               --  well. Should this be done ???

               elsif Is_Record_Type (Typ) then
                  --  It is possible to have an aliased discriminant, so they
                  --  must be checked along with normal components.

                  Comp := First_Component_Or_Discriminant (Typ);
                  while Present (Comp) loop
                     if Is_Aliased (Comp)
                       or else Is_Aliased (Etype (Comp))
                     then
                        VFA_And_Aliased := True;
                        Check_SPARK_05_Restriction
                          ("aliased is not allowed", Comp);

                        exit;
                     end if;

                     Next_Component_Or_Discriminant (Comp);
                  end loop;
               end if;

               if VFA_And_Aliased then
                  Error_Pragma
                    ("cannot apply Volatile_Full_Access (aliased component "
                     & "present)");
               end if;
            end if;
         end Check_VFA_Conflicts;

         ------------------------------
         -- Mark_Component_Or_Object --
         ------------------------------

         procedure Mark_Component_Or_Object (Ent : Entity_Id) is
         begin
            if Prag_Id = Pragma_Atomic
              or else Prag_Id = Pragma_Shared
              or else Prag_Id = Pragma_Volatile_Full_Access
            then
               if Prag_Id = Pragma_Volatile_Full_Access then
                  Set_Is_Volatile_Full_Access (Ent);
               else
                  Set_Is_Atomic (Ent);
               end if;

               --  If the object declaration has an explicit initialization, a
               --  temporary may have to be created to hold the expression, to
               --  ensure that access to the object remains atomic.

               if Nkind (Parent (Ent)) = N_Object_Declaration
                 and then Present (Expression (Parent (Ent)))
               then
                  Set_Has_Delayed_Freeze (Ent);
               end if;
            end if;

            --  Atomic/Shared/Volatile_Full_Access imply Independent

            if Prag_Id /= Pragma_Volatile then
               Set_Is_Independent (Ent);

               if Prag_Id = Pragma_Independent then
                  Record_Independence_Check (N, Ent);
               end if;
            end if;

            --  Atomic/Shared/Volatile_Full_Access imply Volatile

            if Prag_Id /= Pragma_Independent then
               Set_Is_Volatile (Ent);
               Set_Treat_As_Volatile (Ent);
            end if;
         end Mark_Component_Or_Object;

         --------------------
         -- Set_Atomic_VFA --
         --------------------

         procedure Set_Atomic_VFA (Ent : Entity_Id) is
         begin
            if Prag_Id = Pragma_Volatile_Full_Access then
               Set_Is_Volatile_Full_Access (Ent);
            else
               Set_Is_Atomic (Ent);
            end if;

            if not Has_Alignment_Clause (Ent) then
               Set_Alignment (Ent, Uint_0);
            end if;
         end Set_Atomic_VFA;

         --  Local variables

         Decl  : Node_Id;
         E     : Entity_Id;
         E_Arg : Node_Id;

      --  Start of processing for Process_Atomic_Independent_Shared_Volatile

      begin
         Check_Ada_83_Warning;
         Check_No_Identifiers;
         Check_Arg_Count (1);
         Check_Arg_Is_Local_Name (Arg1);
         E_Arg := Get_Pragma_Arg (Arg1);

         if Etype (E_Arg) = Any_Type then
            return;
         end if;

         E := Entity (E_Arg);

         --  A pragma that applies to a Ghost entity becomes Ghost for the
         --  purposes of legality checks and removal of ignored Ghost code.

         Mark_Ghost_Pragma (N, E);

         --  Check duplicate before we chain ourselves

         Check_Duplicate_Pragma (E);

         --  Check appropriateness of the entity

         Decl := Declaration_Node (E);

         --  Deal with the case where the pragma/attribute is applied to a type

         if Is_Type (E) then
            if Rep_Item_Too_Early (E, N)
              or else Rep_Item_Too_Late (E, N)
            then
               return;
            else
               Check_First_Subtype (Arg1);
            end if;

            --  Attribute belongs on the base type. If the view of the type is
            --  currently private, it also belongs on the underlying type.

            if Prag_Id = Pragma_Atomic
              or else Prag_Id = Pragma_Shared
              or else Prag_Id = Pragma_Volatile_Full_Access
            then
               Set_Atomic_VFA (E);
               Set_Atomic_VFA (Base_Type (E));
               Set_Atomic_VFA (Underlying_Type (E));
            end if;

            --  Atomic/Shared/Volatile_Full_Access imply Independent

            if Prag_Id /= Pragma_Volatile then
               Set_Is_Independent (E);
               Set_Is_Independent (Base_Type (E));
               Set_Is_Independent (Underlying_Type (E));

               if Prag_Id = Pragma_Independent then
                  Record_Independence_Check (N, Base_Type (E));
               end if;
            end if;

            --  Atomic/Shared/Volatile_Full_Access imply Volatile

            if Prag_Id /= Pragma_Independent then
               Set_Is_Volatile (E);
               Set_Is_Volatile (Base_Type (E));
               Set_Is_Volatile (Underlying_Type (E));

               Set_Treat_As_Volatile (E);
               Set_Treat_As_Volatile (Underlying_Type (E));
            end if;

            --  Apply Volatile to the composite type's individual components,
            --  (RM C.6(8/3)).

            if Prag_Id = Pragma_Volatile
              and then Is_Record_Type (Etype (E))
            then
               declare
                  Comp : Entity_Id;
               begin
                  Comp := First_Component (E);
                  while Present (Comp) loop
                     Mark_Component_Or_Object (Comp);

                     Next_Component (Comp);
                  end loop;
               end;
            end if;

         --  Deal with the case where the pragma/attribute applies to a
         --  component or object declaration.

         elsif Nkind (Decl) = N_Object_Declaration
           or else (Nkind (Decl) = N_Component_Declaration
                     and then Original_Record_Component (E) = E)
         then
            if Rep_Item_Too_Late (E, N) then
               return;
            end if;

            Mark_Component_Or_Object (E);
         else
            Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
         end if;

         --  Perform the checks needed to assure the proper use of the GNAT
         --  pragma Volatile_Full_Access.

         Check_VFA_Conflicts (E);

         --  The following check is only relevant when SPARK_Mode is on as
         --  this is not a standard Ada legality rule. Pragma Volatile can
         --  only apply to a full type declaration or an object declaration
         --  (SPARK RM 7.1.3(2)). Original_Node is necessary to account for
         --  untagged derived types that are rewritten as subtypes of their
         --  respective root types.

         if SPARK_Mode = On
           and then Prag_Id = Pragma_Volatile
           and then not Nkind_In (Original_Node (Decl),
                                  N_Full_Type_Declaration,
                                  N_Object_Declaration,
                                  N_Single_Protected_Declaration,
                                  N_Single_Task_Declaration)
         then
            Error_Pragma_Arg
              ("argument of pragma % must denote a full type or object "
               & "declaration", Arg1);
         end if;
      end Process_Atomic_Independent_Shared_Volatile;

      -------------------------------------------
      -- Process_Compile_Time_Warning_Or_Error --
      -------------------------------------------

      procedure Process_Compile_Time_Warning_Or_Error is
         Validation_Needed : Boolean := False;

         function Check_Node (N : Node_Id) return Traverse_Result;
         --  Tree visitor that checks if N is an attribute reference that can
         --  be statically computed by the back end. Validation_Needed is set
         --  to True if found.

         ----------------
         -- Check_Node --
         ----------------

         function Check_Node (N : Node_Id) return Traverse_Result is
         begin
            if Nkind (N) = N_Attribute_Reference
              and then Is_Entity_Name (Prefix (N))
            then
               declare
                  Attr_Id : constant Attribute_Id :=
                              Get_Attribute_Id (Attribute_Name (N));
               begin
                  if Attr_Id = Attribute_Alignment
                    or else Attr_Id = Attribute_Size
                  then
                     Validation_Needed := True;
                  end if;
               end;
            end if;

            return OK;
         end Check_Node;

         procedure Check_Expression is new Traverse_Proc (Check_Node);

         --  Local variables

         Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1);

      --  Start of processing for Process_Compile_Time_Warning_Or_Error

      begin
         --  In GNATprove mode, pragmas Compile_Time_Error and
         --  Compile_Time_Warning are ignored, as the analyzer may not have the
         --  same information as the compiler (in particular regarding size of
         --  objects decided in gigi) so it makes no sense to issue an error or
         --  warning in GNATprove.

         if GNATprove_Mode then
            Rewrite (N, Make_Null_Statement (Loc));
            return;
         end if;

         Check_Arg_Count (2);
         Check_No_Identifiers;
         Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String);
         Analyze_And_Resolve (Arg1x, Standard_Boolean);

         if Compile_Time_Known_Value (Arg1x) then
            Process_Compile_Time_Warning_Or_Error (N, Sloc (Arg1));

         --  Register the expression for its validation after the back end has
         --  been called if it has occurrences of attributes Size or Alignment
         --  (because they may be statically computed by the back end and hence
         --  the whole expression needs to be reevaluated).

         else
            Check_Expression (Arg1x);

            if Validation_Needed then
               Sem_Ch13.Validate_Compile_Time_Warning_Error (N);
            end if;
         end if;
      end Process_Compile_Time_Warning_Or_Error;

      ------------------------
      -- Process_Convention --
      ------------------------

      procedure Process_Convention
        (C   : out Convention_Id;
         Ent : out Entity_Id)
      is
         Cname : Name_Id;

         procedure Diagnose_Multiple_Pragmas (S : Entity_Id);
         --  Called if we have more than one Export/Import/Convention pragma.
         --  This is generally illegal, but we have a special case of allowing
         --  Import and Interface to coexist if they specify the convention in
         --  a consistent manner. We are allowed to do this, since Interface is
         --  an implementation defined pragma, and we choose to do it since we
         --  know Rational allows this combination. S is the entity id of the
         --  subprogram in question. This procedure also sets the special flag
         --  Import_Interface_Present in both pragmas in the case where we do
         --  have matching Import and Interface pragmas.

         procedure Set_Convention_From_Pragma (E : Entity_Id);
         --  Set convention in entity E, and also flag that the entity has a
         --  convention pragma. If entity is for a private or incomplete type,
         --  also set convention and flag on underlying type. This procedure
         --  also deals with the special case of C_Pass_By_Copy convention,
         --  and error checks for inappropriate convention specification.

         -------------------------------
         -- Diagnose_Multiple_Pragmas --
         -------------------------------

         procedure Diagnose_Multiple_Pragmas (S : Entity_Id) is
            Pdec : constant Node_Id := Declaration_Node (S);
            Decl : Node_Id;
            Err  : Boolean;

            function Same_Convention (Decl : Node_Id) return Boolean;
            --  Decl is a pragma node. This function returns True if this
            --  pragma has a first argument that is an identifier with a
            --  Chars field corresponding to the Convention_Id C.

            function Same_Name (Decl : Node_Id) return Boolean;
            --  Decl is a pragma node. This function returns True if this
            --  pragma has a second argument that is an identifier with a
            --  Chars field that matches the Chars of the current subprogram.

            ---------------------
            -- Same_Convention --
            ---------------------

            function Same_Convention (Decl : Node_Id) return Boolean is
               Arg1 : constant Node_Id :=
                        First (Pragma_Argument_Associations (Decl));

            begin
               if Present (Arg1) then
                  declare
                     Arg : constant Node_Id := Get_Pragma_Arg (Arg1);
                  begin
                     if Nkind (Arg) = N_Identifier
                       and then Is_Convention_Name (Chars (Arg))
                       and then Get_Convention_Id (Chars (Arg)) = C
                     then
                        return True;
                     end if;
                  end;
               end if;

               return False;
            end Same_Convention;

            ---------------
            -- Same_Name --
            ---------------

            function Same_Name (Decl : Node_Id) return Boolean is
               Arg1 : constant Node_Id :=
                        First (Pragma_Argument_Associations (Decl));
               Arg2 : Node_Id;

            begin
               if No (Arg1) then
                  return False;
               end if;

               Arg2 := Next (Arg1);

               if No (Arg2) then
                  return False;
               end if;

               declare
                  Arg : constant Node_Id := Get_Pragma_Arg (Arg2);
               begin
                  if Nkind (Arg) = N_Identifier
                    and then Chars (Arg) = Chars (S)
                  then
                     return True;
                  end if;
               end;

               return False;
            end Same_Name;

         --  Start of processing for Diagnose_Multiple_Pragmas

         begin
            Err := True;

            --  Definitely give message if we have Convention/Export here

            if Prag_Id = Pragma_Convention or else Prag_Id = Pragma_Export then
               null;

               --  If we have an Import or Export, scan back from pragma to
               --  find any previous pragma applying to the same procedure.
               --  The scan will be terminated by the start of the list, or
               --  hitting the subprogram declaration. This won't allow one
               --  pragma to appear in the public part and one in the private
               --  part, but that seems very unlikely in practice.

            else
               Decl := Prev (N);
               while Present (Decl) and then Decl /= Pdec loop

                  --  Look for pragma with same name as us

                  if Nkind (Decl) = N_Pragma
                    and then Same_Name (Decl)
                  then
                     --  Give error if same as our pragma or Export/Convention

                     if Nam_In (Pragma_Name_Unmapped (Decl),
                                Name_Export,
                                Name_Convention,
                                Pragma_Name_Unmapped (N))
                     then
                        exit;

                     --  Case of Import/Interface or the other way round

                     elsif Nam_In (Pragma_Name_Unmapped (Decl),
                                   Name_Interface, Name_Import)
                     then
                        --  Here we know that we have Import and Interface. It
                        --  doesn't matter which way round they are. See if
                        --  they specify the same convention. If so, all OK,
                        --  and set special flags to stop other messages

                        if Same_Convention (Decl) then
                           Set_Import_Interface_Present (N);
                           Set_Import_Interface_Present (Decl);
                           Err := False;

                        --  If different conventions, special message

                        else
                           Error_Msg_Sloc := Sloc (Decl);
                           Error_Pragma_Arg
                             ("convention differs from that given#", Arg1);
                           return;
                        end if;
                     end if;
                  end if;

                  Next (Decl);
               end loop;
            end if;

            --  Give message if needed if we fall through those tests
            --  except on Relaxed_RM_Semantics where we let go: either this
            --  is a case accepted/ignored by other Ada compilers (e.g.
            --  a mix of Convention and Import), or another error will be
            --  generated later (e.g. using both Import and Export).

            if Err and not Relaxed_RM_Semantics then
               Error_Pragma_Arg
                 ("at most one Convention/Export/Import pragma is allowed",
                  Arg2);
            end if;
         end Diagnose_Multiple_Pragmas;

         --------------------------------
         -- Set_Convention_From_Pragma --
         --------------------------------

         procedure Set_Convention_From_Pragma (E : Entity_Id) is
         begin
            --  Ada 2005 (AI-430): Check invalid attempt to change convention
            --  for an overridden dispatching operation. Technically this is
            --  an amendment and should only be done in Ada 2005 mode. However,
            --  this is clearly a mistake, since the problem that is addressed
            --  by this AI is that there is a clear gap in the RM.

            if Is_Dispatching_Operation (E)
              and then Present (Overridden_Operation (E))
              and then C /= Convention (Overridden_Operation (E))
            then
               Error_Pragma_Arg
                 ("cannot change convention for overridden dispatching "
                  & "operation", Arg1);
            end if;

            --  Special checks for Convention_Stdcall

            if C = Convention_Stdcall then

               --  A dispatching call is not allowed. A dispatching subprogram
               --  cannot be used to interface to the Win32 API, so in fact
               --  this check does not impose any effective restriction.

               if Is_Dispatching_Operation (E) then
                  Error_Msg_Sloc := Sloc (E);

                  --  Note: make this unconditional so that if there is more
                  --  than one call to which the pragma applies, we get a
                  --  message for each call. Also don't use Error_Pragma,
                  --  so that we get multiple messages.

                  Error_Msg_N
                    ("dispatching subprogram# cannot use Stdcall convention!",
                     Arg1);

               --  Several allowed cases

               elsif Is_Subprogram_Or_Generic_Subprogram (E)

                 --  A variable is OK

                 or else Ekind (E) = E_Variable

                 --  A component as well. The entity does not have its Ekind
                 --  set until the enclosing record declaration is fully
                 --  analyzed.

                 or else Nkind (Parent (E)) = N_Component_Declaration

                 --  An access to subprogram is also allowed

                 or else
                   (Is_Access_Type (E)
                     and then Ekind (Designated_Type (E)) = E_Subprogram_Type)

                 --  Allow internal call to set convention of subprogram type

                 or else Ekind (E) = E_Subprogram_Type
               then
                  null;

               else
                  Error_Pragma_Arg
                    ("second argument of pragma% must be subprogram (type)",
                     Arg2);
               end if;
            end if;

            --  Set the convention

            Set_Convention (E, C);
            Set_Has_Convention_Pragma (E);

            --  For the case of a record base type, also set the convention of
            --  any anonymous access types declared in the record which do not
            --  currently have a specified convention.

            if Is_Record_Type (E) and then Is_Base_Type (E) then
               declare
                  Comp : Node_Id;

               begin
                  Comp := First_Component (E);
                  while Present (Comp) loop
                     if Present (Etype (Comp))
                       and then Ekind_In (Etype (Comp),
                                          E_Anonymous_Access_Type,
                                          E_Anonymous_Access_Subprogram_Type)
                       and then not Has_Convention_Pragma (Comp)
                     then
                        Set_Convention (Comp, C);
                     end if;

                     Next_Component (Comp);
                  end loop;
               end;
            end if;

            --  Deal with incomplete/private type case, where underlying type
            --  is available, so set convention of that underlying type.

            if Is_Incomplete_Or_Private_Type (E)
              and then Present (Underlying_Type (E))
            then
               Set_Convention            (Underlying_Type (E), C);
               Set_Has_Convention_Pragma (Underlying_Type (E), True);
            end if;

            --  A class-wide type should inherit the convention of the specific
            --  root type (although this isn't specified clearly by the RM).

            if Is_Type (E) and then Present (Class_Wide_Type (E)) then
               Set_Convention (Class_Wide_Type (E), C);
            end if;

            --  If the entity is a record type, then check for special case of
            --  C_Pass_By_Copy, which is treated the same as C except that the
            --  special record flag is set. This convention is only permitted
            --  on record types (see AI95-00131).

            if Cname = Name_C_Pass_By_Copy then
               if Is_Record_Type (E) then
                  Set_C_Pass_By_Copy (Base_Type (E));
               elsif Is_Incomplete_Or_Private_Type (E)
                 and then Is_Record_Type (Underlying_Type (E))
               then
                  Set_C_Pass_By_Copy (Base_Type (Underlying_Type (E)));
               else
                  Error_Pragma_Arg
                    ("C_Pass_By_Copy convention allowed only for record type",
                     Arg2);
               end if;
            end if;

            --  If the entity is a derived boolean type, check for the special
            --  case of convention C, C++, or Fortran, where we consider any
            --  nonzero value to represent true.

            if Is_Discrete_Type (E)
              and then Root_Type (Etype (E)) = Standard_Boolean
              and then
                (C = Convention_C
                   or else
                 C = Convention_CPP
                   or else
                 C = Convention_Fortran)
            then
               Set_Nonzero_Is_True (Base_Type (E));
            end if;
         end Set_Convention_From_Pragma;

         --  Local variables

         Comp_Unit : Unit_Number_Type;
         E         : Entity_Id;
         E1        : Entity_Id;
         Id        : Node_Id;

      --  Start of processing for Process_Convention

      begin
         Check_At_Least_N_Arguments (2);
         Check_Optional_Identifier (Arg1, Name_Convention);
         Check_Arg_Is_Identifier (Arg1);
         Cname := Chars (Get_Pragma_Arg (Arg1));

         --  C_Pass_By_Copy is treated as a synonym for convention C (this is
         --  tested again below to set the critical flag).

         if Cname = Name_C_Pass_By_Copy then
            C := Convention_C;

         --  Otherwise we must have something in the standard convention list

         elsif Is_Convention_Name (Cname) then
            C := Get_Convention_Id (Chars (Get_Pragma_Arg (Arg1)));

         --  Otherwise warn on unrecognized convention

         else
            if Warn_On_Export_Import then
               Error_Msg_N
                 ("??unrecognized convention name, C assumed",
                  Get_Pragma_Arg (Arg1));
            end if;

            C := Convention_C;
         end if;

         Check_Optional_Identifier (Arg2, Name_Entity);
         Check_Arg_Is_Local_Name (Arg2);

         Id := Get_Pragma_Arg (Arg2);
         Analyze (Id);

         if not Is_Entity_Name (Id) then
            Error_Pragma_Arg ("entity name required", Arg2);
         end if;

         E := Entity (Id);

         --  Set entity to return

         Ent := E;

         --  Ada_Pass_By_Copy special checking

         if C = Convention_Ada_Pass_By_Copy then
            if not Is_First_Subtype (E) then
               Error_Pragma_Arg
                 ("convention `Ada_Pass_By_Copy` only allowed for types",
                  Arg2);
            end if;

            if Is_By_Reference_Type (E) then
               Error_Pragma_Arg
                 ("convention `Ada_Pass_By_Copy` not allowed for by-reference "
                  & "type", Arg1);
            end if;

         --  Ada_Pass_By_Reference special checking

         elsif C = Convention_Ada_Pass_By_Reference then
            if not Is_First_Subtype (E) then
               Error_Pragma_Arg
                 ("convention `Ada_Pass_By_Reference` only allowed for types",
                  Arg2);
            end if;

            if Is_By_Copy_Type (E) then
               Error_Pragma_Arg
                 ("convention `Ada_Pass_By_Reference` not allowed for by-copy "
                  & "type", Arg1);
            end if;
         end if;

         --  Go to renamed subprogram if present, since convention applies to
         --  the actual renamed entity, not to the renaming entity. If the
         --  subprogram is inherited, go to parent subprogram.

         if Is_Subprogram (E)
           and then Present (Alias (E))
         then
            if Nkind (Parent (Declaration_Node (E))) =
                                       N_Subprogram_Renaming_Declaration
            then
               if Scope (E) /= Scope (Alias (E)) then
                  Error_Pragma_Ref
                    ("cannot apply pragma% to non-local entity&#", E);
               end if;

               E := Alias (E);

            elsif Nkind_In (Parent (E), N_Full_Type_Declaration,
                                        N_Private_Extension_Declaration)
              and then Scope (E) = Scope (Alias (E))
            then
               E := Alias (E);

               --  Return the parent subprogram the entity was inherited from

               Ent := E;
            end if;
         end if;

         --  Check that we are not applying this to a specless body. Relax this
         --  check if Relaxed_RM_Semantics to accommodate other Ada compilers.

         if Is_Subprogram (E)
           and then Nkind (Parent (Declaration_Node (E))) = N_Subprogram_Body
           and then not Relaxed_RM_Semantics
         then
            Error_Pragma
              ("pragma% requires separate spec and must come before body");
         end if;

         --  Check that we are not applying this to a named constant

         if Ekind_In (E, E_Named_Integer, E_Named_Real) then
            Error_Msg_Name_1 := Pname;
            Error_Msg_N
              ("cannot apply pragma% to named constant!",
               Get_Pragma_Arg (Arg2));
            Error_Pragma_Arg
              ("\supply appropriate type for&!", Arg2);
         end if;

         if Ekind (E) = E_Enumeration_Literal then
            Error_Pragma ("enumeration literal not allowed for pragma%");
         end if;

         --  Check for rep item appearing too early or too late

         if Etype (E) = Any_Type
           or else Rep_Item_Too_Early (E, N)
         then
            raise Pragma_Exit;

         elsif Present (Underlying_Type (E)) then
            E := Underlying_Type (E);
         end if;

         if Rep_Item_Too_Late (E, N) then
            raise Pragma_Exit;
         end if;

         if Has_Convention_Pragma (E) then
            Diagnose_Multiple_Pragmas (E);

         elsif Convention (E) = Convention_Protected
           or else Ekind (Scope (E)) = E_Protected_Type
         then
            Error_Pragma_Arg
              ("a protected operation cannot be given a different convention",
                Arg2);
         end if;

         --  For Intrinsic, a subprogram is required

         if C = Convention_Intrinsic
           and then not Is_Subprogram_Or_Generic_Subprogram (E)
         then
            --  Accept Intrinsic Export on types if Relaxed_RM_Semantics

            if not (Is_Type (E) and then Relaxed_RM_Semantics) then
               Error_Pragma_Arg
                 ("second argument of pragma% must be a subprogram", Arg2);
            end if;
         end if;

         --  Deal with non-subprogram cases

         if not Is_Subprogram_Or_Generic_Subprogram (E) then
            Set_Convention_From_Pragma (E);

            if Is_Type (E) then

               --  The pragma must apply to a first subtype, but it can also
               --  apply to a generic type in a generic formal part, in which
               --  case it will also appear in the corresponding instance.

               if Is_Generic_Type (E) or else In_Instance then
                  null;
               else
                  Check_First_Subtype (Arg2);
               end if;

               Set_Convention_From_Pragma (Base_Type (E));

               --  For access subprograms, we must set the convention on the
               --  internally generated directly designated type as well.

               if Ekind (E) = E_Access_Subprogram_Type then
                  Set_Convention_From_Pragma (Directly_Designated_Type (E));
               end if;
            end if;

         --  For the subprogram case, set proper convention for all homonyms
         --  in same scope and the same declarative part, i.e. the same
         --  compilation unit.

         else
            Comp_Unit := Get_Source_Unit (E);
            Set_Convention_From_Pragma (E);

            --  Treat a pragma Import as an implicit body, and pragma import
            --  as implicit reference (for navigation in GPS).

            if Prag_Id = Pragma_Import then
               Generate_Reference (E, Id, 'b');

            --  For exported entities we restrict the generation of references
            --  to entities exported to foreign languages since entities
            --  exported to Ada do not provide further information to GPS and
            --  add undesired references to the output of the gnatxref tool.

            elsif Prag_Id = Pragma_Export
              and then Convention (E) /= Convention_Ada
            then
               Generate_Reference (E, Id, 'i');
            end if;

            --  If the pragma comes from an aspect, it only applies to the
            --  given entity, not its homonyms.

            if From_Aspect_Specification (N) then
               if C = Convention_Intrinsic
                 and then Nkind (Ent) = N_Defining_Operator_Symbol
               then
                  if Is_Fixed_Point_Type (Etype (Ent))
                    or else Is_Fixed_Point_Type (Etype (First_Entity (Ent)))
                    or else Is_Fixed_Point_Type (Etype (Last_Entity (Ent)))
                  then
                     Error_Msg_N
                       ("no intrinsic operator available for this fixed-point "
                        & "operation", N);
                     Error_Msg_N
                       ("\use expression functions with the desired "
                        & "conversions made explicit", N);
                  end if;
               end if;

               return;
            end if;

            --  Otherwise Loop through the homonyms of the pragma argument's
            --  entity, an apply convention to those in the current scope.

            E1 := Ent;

            loop
               E1 := Homonym (E1);
               exit when No (E1) or else Scope (E1) /= Current_Scope;

               --  Ignore entry for which convention is already set

               if Has_Convention_Pragma (E1) then
                  goto Continue;
               end if;

               if Is_Subprogram (E1)
                 and then Nkind (Parent (Declaration_Node (E1))) =
                            N_Subprogram_Body
                 and then not Relaxed_RM_Semantics
               then
                  Set_Has_Completion (E);  --  to prevent cascaded error
                  Error_Pragma_Ref
                    ("pragma% requires separate spec and must come before "
                     & "body#", E1);
               end if;

               --  Do not set the pragma on inherited operations or on formal
               --  subprograms.

               if Comes_From_Source (E1)
                 and then Comp_Unit = Get_Source_Unit (E1)
                 and then not Is_Formal_Subprogram (E1)
                 and then Nkind (Original_Node (Parent (E1))) /=
                                                    N_Full_Type_Declaration
               then
                  if Present (Alias (E1))
                    and then Scope (E1) /= Scope (Alias (E1))
                  then
                     Error_Pragma_Ref
                       ("cannot apply pragma% to non-local entity& declared#",
                        E1);
                  end if;

                  Set_Convention_From_Pragma (E1);

                  if Prag_Id = Pragma_Import then
                     Generate_Reference (E1, Id, 'b');
                  end if;
               end if;

            <<Continue>>
               null;
            end loop;
         end if;
      end Process_Convention;

      ----------------------------------------
      -- Process_Disable_Enable_Atomic_Sync --
      ----------------------------------------

      procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id) is
      begin
         Check_No_Identifiers;
         Check_At_Most_N_Arguments (1);

         --  Modeled internally as
         --    pragma Suppress/Unsuppress (Atomic_Synchronization [,Entity])

         Rewrite (N,
           Make_Pragma (Loc,
             Chars                        => Nam,
             Pragma_Argument_Associations => New_List (
               Make_Pragma_Argument_Association (Loc,
                 Expression =>
                   Make_Identifier (Loc, Name_Atomic_Synchronization)))));

         if Present (Arg1) then
            Append_To (Pragma_Argument_Associations (N), New_Copy (Arg1));
         end if;

         Analyze (N);
      end Process_Disable_Enable_Atomic_Sync;

      -------------------------------------------------
      -- Process_Extended_Import_Export_Internal_Arg --
      -------------------------------------------------

      procedure Process_Extended_Import_Export_Internal_Arg
        (Arg_Internal : Node_Id := Empty)
      is
      begin
         if No (Arg_Internal) then
            Error_Pragma ("Internal parameter required for pragma%");
         end if;

         if Nkind (Arg_Internal) = N_Identifier then
            null;

         elsif Nkind (Arg_Internal) = N_Operator_Symbol
           and then (Prag_Id = Pragma_Import_Function
                       or else
                     Prag_Id = Pragma_Export_Function)
         then
            null;

         else
            Error_Pragma_Arg
              ("wrong form for Internal parameter for pragma%", Arg_Internal);
         end if;

         Check_Arg_Is_Local_Name (Arg_Internal);
      end Process_Extended_Import_Export_Internal_Arg;

      --------------------------------------------------
      -- Process_Extended_Import_Export_Object_Pragma --
      --------------------------------------------------

      procedure Process_Extended_Import_Export_Object_Pragma
        (Arg_Internal : Node_Id;
         Arg_External : Node_Id;
         Arg_Size     : Node_Id)
      is
         Def_Id : Entity_Id;

      begin
         Process_Extended_Import_Export_Internal_Arg (Arg_Internal);
         Def_Id := Entity (Arg_Internal);

         if not Ekind_In (Def_Id, E_Constant, E_Variable) then
            Error_Pragma_Arg
              ("pragma% must designate an object", Arg_Internal);
         end if;

         if Has_Rep_Pragma (Def_Id, Name_Common_Object)
              or else
            Has_Rep_Pragma (Def_Id, Name_Psect_Object)
         then
            Error_Pragma_Arg
              ("previous Common/Psect_Object applies, pragma % not permitted",
               Arg_Internal);
         end if;

         if Rep_Item_Too_Late (Def_Id, N) then
            raise Pragma_Exit;
         end if;

         Set_Extended_Import_Export_External_Name (Def_Id, Arg_External);

         if Present (Arg_Size) then
            Check_Arg_Is_External_Name (Arg_Size);
         end if;

         --  Export_Object case

         if Prag_Id = Pragma_Export_Object then
            if not Is_Library_Level_Entity (Def_Id) then
               Error_Pragma_Arg
                 ("argument for pragma% must be library level entity",
                  Arg_Internal);
            end if;

            if Ekind (Current_Scope) = E_Generic_Package then
               Error_Pragma ("pragma& cannot appear in a generic unit");
            end if;

            if not Size_Known_At_Compile_Time (Etype (Def_Id)) then
               Error_Pragma_Arg
                 ("exported object must have compile time known size",
                  Arg_Internal);
            end if;

            if Warn_On_Export_Import and then Is_Exported (Def_Id) then
               Error_Msg_N ("??duplicate Export_Object pragma", N);
            else
               Set_Exported (Def_Id, Arg_Internal);
            end if;

         --  Import_Object case

         else
            if Is_Concurrent_Type (Etype (Def_Id)) then
               Error_Pragma_Arg
                 ("cannot use pragma% for task/protected object",
                  Arg_Internal);
            end if;

            if Ekind (Def_Id) = E_Constant then
               Error_Pragma_Arg
                 ("cannot import a constant", Arg_Internal);
            end if;

            if Warn_On_Export_Import
              and then Has_Discriminants (Etype (Def_Id))
            then
               Error_Msg_N
                 ("imported value must be initialized??", Arg_Internal);
            end if;

            if Warn_On_Export_Import
              and then Is_Access_Type (Etype (Def_Id))
            then
               Error_Pragma_Arg
                 ("cannot import object of an access type??", Arg_Internal);
            end if;

            if Warn_On_Export_Import
              and then Is_Imported (Def_Id)
            then
               Error_Msg_N ("??duplicate Import_Object pragma", N);

            --  Check for explicit initialization present. Note that an
            --  initialization generated by the code generator, e.g. for an
            --  access type, does not count here.

            elsif Present (Expression (Parent (Def_Id)))
               and then
                 Comes_From_Source
                   (Original_Node (Expression (Parent (Def_Id))))
            then
               Error_Msg_Sloc := Sloc (Def_Id);
               Error_Pragma_Arg
                 ("imported entities cannot be initialized (RM B.1(24))",
                  "\no initialization allowed for & declared#", Arg1);
            else
               Set_Imported (Def_Id);
               Note_Possible_Modification (Arg_Internal, Sure => False);
            end if;
         end if;
      end Process_Extended_Import_Export_Object_Pragma;

      ------------------------------------------------------
      -- Process_Extended_Import_Export_Subprogram_Pragma --
      ------------------------------------------------------

      procedure Process_Extended_Import_Export_Subprogram_Pragma
        (Arg_Internal                 : Node_Id;
         Arg_External                 : Node_Id;
         Arg_Parameter_Types          : Node_Id;
         Arg_Result_Type              : Node_Id := Empty;
         Arg_Mechanism                : Node_Id;
         Arg_Result_Mechanism         : Node_Id := Empty)
      is
         Ent       : Entity_Id;
         Def_Id    : Entity_Id;
         Hom_Id    : Entity_Id;
         Formal    : Entity_Id;
         Ambiguous : Boolean;
         Match     : Boolean;

         function Same_Base_Type
          (Ptype  : Node_Id;
           Formal : Entity_Id) return Boolean;
         --  Determines if Ptype references the type of Formal. Note that only
         --  the base types need to match according to the spec. Ptype here is
         --  the argument from the pragma, which is either a type name, or an
         --  access attribute.

         --------------------
         -- Same_Base_Type --
         --------------------

         function Same_Base_Type
           (Ptype  : Node_Id;
            Formal : Entity_Id) return Boolean
         is
            Ftyp : constant Entity_Id := Base_Type (Etype (Formal));
            Pref : Node_Id;

         begin
            --  Case where pragma argument is typ'Access

            if Nkind (Ptype) = N_Attribute_Reference
              and then Attribute_Name (Ptype) = Name_Access
            then
               Pref := Prefix (Ptype);
               Find_Type (Pref);

               if not Is_Entity_Name (Pref)
                 or else Entity (Pref) = Any_Type
               then
                  raise Pragma_Exit;
               end if;

               --  We have a match if the corresponding argument is of an
               --  anonymous access type, and its designated type matches the
               --  type of the prefix of the access attribute

               return Ekind (Ftyp) = E_Anonymous_Access_Type
                 and then Base_Type (Entity (Pref)) =
                            Base_Type (Etype (Designated_Type (Ftyp)));

            --  Case where pragma argument is a type name

            else
               Find_Type (Ptype);

               if not Is_Entity_Name (Ptype)
                 or else Entity (Ptype) = Any_Type
               then
                  raise Pragma_Exit;
               end if;

               --  We have a match if the corresponding argument is of the type
               --  given in the pragma (comparing base types)

               return Base_Type (Entity (Ptype)) = Ftyp;
            end if;
         end Same_Base_Type;

      --  Start of processing for
      --  Process_Extended_Import_Export_Subprogram_Pragma

      begin
         Process_Extended_Import_Export_Internal_Arg (Arg_Internal);
         Ent := Empty;
         Ambiguous := False;

         --  Loop through homonyms (overloadings) of the entity

         Hom_Id := Entity (Arg_Internal);
         while Present (Hom_Id) loop
            Def_Id := Get_Base_Subprogram (Hom_Id);

            --  We need a subprogram in the current scope

            if not Is_Subprogram (Def_Id)
              or else Scope (Def_Id) /= Current_Scope
            then
               null;

            else
               Match := True;

               --  Pragma cannot apply to subprogram body

               if Is_Subprogram (Def_Id)
                 and then Nkind (Parent (Declaration_Node (Def_Id))) =
                                                             N_Subprogram_Body
               then
                  Error_Pragma
                    ("pragma% requires separate spec and must come before "
                     & "body");
               end if;

               --  Test result type if given, note that the result type
               --  parameter can only be present for the function cases.

               if Present (Arg_Result_Type)
                 and then not Same_Base_Type (Arg_Result_Type, Def_Id)
               then
                  Match := False;

               elsif Etype (Def_Id) /= Standard_Void_Type
                 and then Nam_In (Pname, Name_Export_Procedure,
                                         Name_Import_Procedure)
               then
                  Match := False;

               --  Test parameter types if given. Note that this parameter has
               --  not been analyzed (and must not be, since it is semantic
               --  nonsense), so we get it as the parser left it.

               elsif Present (Arg_Parameter_Types) then
                  Check_Matching_Types : declare
                     Formal : Entity_Id;
                     Ptype  : Node_Id;

                  begin
                     Formal := First_Formal (Def_Id);

                     if Nkind (Arg_Parameter_Types) = N_Null then
                        if Present (Formal) then
                           Match := False;
                        end if;

                     --  A list of one type, e.g. (List) is parsed as a
                     --  parenthesized expression.

                     elsif Nkind (Arg_Parameter_Types) /= N_Aggregate
                       and then Paren_Count (Arg_Parameter_Types) = 1
                     then
                        if No (Formal)
                          or else Present (Next_Formal (Formal))
                        then
                           Match := False;
                        else
                           Match :=
                             Same_Base_Type (Arg_Parameter_Types, Formal);
                        end if;

                     --  A list of more than one type is parsed as a aggregate

                     elsif Nkind (Arg_Parameter_Types) = N_Aggregate
                       and then Paren_Count (Arg_Parameter_Types) = 0
                     then
                        Ptype := First (Expressions (Arg_Parameter_Types));
                        while Present (Ptype) or else Present (Formal) loop
                           if No (Ptype)
                             or else No (Formal)
                             or else not Same_Base_Type (Ptype, Formal)
                           then
                              Match := False;
                              exit;
                           else
                              Next_Formal (Formal);
                              Next (Ptype);
                           end if;
                        end loop;

                     --  Anything else is of the wrong form

                     else
                        Error_Pragma_Arg
                          ("wrong form for Parameter_Types parameter",
                           Arg_Parameter_Types);
                     end if;
                  end Check_Matching_Types;
               end if;

               --  Match is now False if the entry we found did not match
               --  either a supplied Parameter_Types or Result_Types argument

               if Match then
                  if No (Ent) then
                     Ent := Def_Id;

                  --  Ambiguous case, the flag Ambiguous shows if we already
                  --  detected this and output the initial messages.

                  else
                     if not Ambiguous then
                        Ambiguous := True;
                        Error_Msg_Name_1 := Pname;
                        Error_Msg_N
                          ("pragma% does not uniquely identify subprogram!",
                           N);
                        Error_Msg_Sloc := Sloc (Ent);
                        Error_Msg_N ("matching subprogram #!", N);
                        Ent := Empty;
                     end if;

                     Error_Msg_Sloc := Sloc (Def_Id);
                     Error_Msg_N ("matching subprogram #!", N);
                  end if;
               end if;
            end if;

            Hom_Id := Homonym (Hom_Id);
         end loop;

         --  See if we found an entry

         if No (Ent) then
            if not Ambiguous then
               if Is_Generic_Subprogram (Entity (Arg_Internal)) then
                  Error_Pragma
                    ("pragma% cannot be given for generic subprogram");
               else
                  Error_Pragma
                    ("pragma% does not identify local subprogram");
               end if;
            end if;

            return;
         end if;

         --  Import pragmas must be for imported entities

         if Prag_Id = Pragma_Import_Function
              or else
            Prag_Id = Pragma_Import_Procedure
              or else
            Prag_Id = Pragma_Import_Valued_Procedure
         then
            if not Is_Imported (Ent) then
               Error_Pragma
                 ("pragma Import or Interface must precede pragma%");
            end if;

         --  Here we have the Export case which can set the entity as exported

         --  But does not do so if the specified external name is null, since
         --  that is taken as a signal in DEC Ada 83 (with which we want to be
         --  compatible) to request no external name.

         elsif Nkind (Arg_External) = N_String_Literal
           and then String_Length (Strval (Arg_External)) = 0
         then
            null;

         --  In all other cases, set entity as exported

         else
            Set_Exported (Ent, Arg_Internal);
         end if;

         --  Special processing for Valued_Procedure cases

         if Prag_Id = Pragma_Import_Valued_Procedure
           or else
            Prag_Id = Pragma_Export_Valued_Procedure
         then
            Formal := First_Formal (Ent);

            if No (Formal) then
               Error_Pragma ("at least one parameter required for pragma%");

            elsif Ekind (Formal) /= E_Out_Parameter then
               Error_Pragma ("first parameter must have mode out for pragma%");

            else
               Set_Is_Valued_Procedure (Ent);
            end if;
         end if;

         Set_Extended_Import_Export_External_Name (Ent, Arg_External);

         --  Process Result_Mechanism argument if present. We have already
         --  checked that this is only allowed for the function case.

         if Present (Arg_Result_Mechanism) then
            Set_Mechanism_Value (Ent, Arg_Result_Mechanism);
         end if;

         --  Process Mechanism parameter if present. Note that this parameter
         --  is not analyzed, and must not be analyzed since it is semantic
         --  nonsense, so we get it in exactly as the parser left it.

         if Present (Arg_Mechanism) then
            declare
               Formal : Entity_Id;
               Massoc : Node_Id;
               Mname  : Node_Id;
               Choice : Node_Id;

            begin
               --  A single mechanism association without a formal parameter
               --  name is parsed as a parenthesized expression. All other
               --  cases are parsed as aggregates, so we rewrite the single
               --  parameter case as an aggregate for consistency.

               if Nkind (Arg_Mechanism) /= N_Aggregate
                 and then Paren_Count (Arg_Mechanism) = 1
               then
                  Rewrite (Arg_Mechanism,
                    Make_Aggregate (Sloc (Arg_Mechanism),
                      Expressions => New_List (
                        Relocate_Node (Arg_Mechanism))));
               end if;

               --  Case of only mechanism name given, applies to all formals

               if Nkind (Arg_Mechanism) /= N_Aggregate then
                  Formal := First_Formal (Ent);
                  while Present (Formal) loop
                     Set_Mechanism_Value (Formal, Arg_Mechanism);
                     Next_Formal (Formal);
                  end loop;

               --  Case of list of mechanism associations given

               else
                  if Null_Record_Present (Arg_Mechanism) then
                     Error_Pragma_Arg
                       ("inappropriate form for Mechanism parameter",
                        Arg_Mechanism);
                  end if;

                  --  Deal with positional ones first

                  Formal := First_Formal (Ent);

                  if Present (Expressions (Arg_Mechanism)) then
                     Mname := First (Expressions (Arg_Mechanism));
                     while Present (Mname) loop
                        if No (Formal) then
                           Error_Pragma_Arg
                             ("too many mechanism associations", Mname);
                        end if;

                        Set_Mechanism_Value (Formal, Mname);
                        Next_Formal (Formal);
                        Next (Mname);
                     end loop;
                  end if;

                  --  Deal with named entries

                  if Present (Component_Associations (Arg_Mechanism)) then
                     Massoc := First (Component_Associations (Arg_Mechanism));
                     while Present (Massoc) loop
                        Choice := First (Choices (Massoc));

                        if Nkind (Choice) /= N_Identifier
                          or else Present (Next (Choice))
                        then
                           Error_Pragma_Arg
                             ("incorrect form for mechanism association",
                              Massoc);
                        end if;

                        Formal := First_Formal (Ent);
                        loop
                           if No (Formal) then
                              Error_Pragma_Arg
                                ("parameter name & not present", Choice);
                           end if;

                           if Chars (Choice) = Chars (Formal) then
                              Set_Mechanism_Value
                                (Formal, Expression (Massoc));

                              --  Set entity on identifier (needed by ASIS)

                              Set_Entity (Choice, Formal);

                              exit;
                           end if;

                           Next_Formal (Formal);
                        end loop;

                        Next (Massoc);
                     end loop;
                  end if;
               end if;
            end;
         end if;
      end Process_Extended_Import_Export_Subprogram_Pragma;

      --------------------------
      -- Process_Generic_List --
      --------------------------

      procedure Process_Generic_List is
         Arg : Node_Id;
         Exp : Node_Id;

      begin
         Check_No_Identifiers;
         Check_At_Least_N_Arguments (1);

         --  Check all arguments are names of generic units or instances

         Arg := Arg1;
         while Present (Arg) loop
            Exp := Get_Pragma_Arg (Arg);
            Analyze (Exp);

            if not Is_Entity_Name (Exp)
              or else
                (not Is_Generic_Instance (Entity (Exp))
                  and then
                 not Is_Generic_Unit (Entity (Exp)))
            then
               Error_Pragma_Arg
                 ("pragma% argument must be name of generic unit/instance",
                  Arg);
            end if;

            Next (Arg);
         end loop;
      end Process_Generic_List;

      ------------------------------------
      -- Process_Import_Predefined_Type --
      ------------------------------------

      procedure Process_Import_Predefined_Type is
         Loc  : constant Source_Ptr := Sloc (N);
         Elmt : Elmt_Id;
         Ftyp : Node_Id := Empty;
         Decl : Node_Id;
         Def  : Node_Id;
         Nam  : Name_Id;

      begin
         Nam := String_To_Name (Strval (Expression (Arg3)));

         Elmt := First_Elmt (Predefined_Float_Types);
         while Present (Elmt) and then Chars (Node (Elmt)) /= Nam loop
            Next_Elmt (Elmt);
         end loop;

         Ftyp := Node (Elmt);

         if Present (Ftyp) then

            --  Don't build a derived type declaration, because predefined C
            --  types have no declaration anywhere, so cannot really be named.
            --  Instead build a full type declaration, starting with an
            --  appropriate type definition is built

            if Is_Floating_Point_Type (Ftyp) then
               Def := Make_Floating_Point_Definition (Loc,
                 Make_Integer_Literal (Loc, Digits_Value (Ftyp)),
                 Make_Real_Range_Specification (Loc,
                   Make_Real_Literal (Loc, Realval (Type_Low_Bound (Ftyp))),
                   Make_Real_Literal (Loc, Realval (Type_High_Bound (Ftyp)))));

            --  Should never have a predefined type we cannot handle

            else
               raise Program_Error;
            end if;

            --  Build and insert a Full_Type_Declaration, which will be
            --  analyzed as soon as this list entry has been analyzed.

            Decl := Make_Full_Type_Declaration (Loc,
              Make_Defining_Identifier (Loc, Chars (Expression (Arg2))),
              Type_Definition => Def);

            Insert_After (N, Decl);
            Mark_Rewrite_Insertion (Decl);

         else
            Error_Pragma_Arg ("no matching type found for pragma%",
            Arg2);
         end if;
      end Process_Import_Predefined_Type;

      ---------------------------------
      -- Process_Import_Or_Interface --
      ---------------------------------

      procedure Process_Import_Or_Interface is
         C      : Convention_Id;
         Def_Id : Entity_Id;
         Hom_Id : Entity_Id;

      begin
         --  In Relaxed_RM_Semantics, support old Ada 83 style:
         --  pragma Import (Entity, "external name");

         if Relaxed_RM_Semantics
           and then Arg_Count = 2
           and then Prag_Id = Pragma_Import
           and then Nkind (Expression (Arg2)) = N_String_Literal
         then
            C := Convention_C;
            Def_Id := Get_Pragma_Arg (Arg1);
            Analyze (Def_Id);

            if not Is_Entity_Name (Def_Id) then
               Error_Pragma_Arg ("entity name required", Arg1);
            end if;

            Def_Id := Entity (Def_Id);
            Kill_Size_Check_Code (Def_Id);
            Note_Possible_Modification (Get_Pragma_Arg (Arg1), Sure => False);

         else
            Process_Convention (C, Def_Id);

            --  A pragma that applies to a Ghost entity becomes Ghost for the
            --  purposes of legality checks and removal of ignored Ghost code.

            Mark_Ghost_Pragma (N, Def_Id);
            Kill_Size_Check_Code (Def_Id);
            Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False);
         end if;

         --  Various error checks

         if Ekind_In (Def_Id, E_Variable, E_Constant) then

            --  We do not permit Import to apply to a renaming declaration

            if Present (Renamed_Object (Def_Id)) then
               Error_Pragma_Arg
                 ("pragma% not allowed for object renaming", Arg2);

            --  User initialization is not allowed for imported object, but
            --  the object declaration may contain a default initialization,
            --  that will be discarded. Note that an explicit initialization
            --  only counts if it comes from source, otherwise it is simply
            --  the code generator making an implicit initialization explicit.

            elsif Present (Expression (Parent (Def_Id)))
              and then Comes_From_Source
                         (Original_Node (Expression (Parent (Def_Id))))
            then
               --  Set imported flag to prevent cascaded errors

               Set_Is_Imported (Def_Id);

               Error_Msg_Sloc := Sloc (Def_Id);
               Error_Pragma_Arg
                 ("no initialization allowed for declaration of& #",
                  "\imported entities cannot be initialized (RM B.1(24))",
                  Arg2);

            else
               --  If the pragma comes from an aspect specification the
               --  Is_Imported flag has already been set.

               if not From_Aspect_Specification (N) then
                  Set_Imported (Def_Id);
               end if;

               Process_Interface_Name (Def_Id, Arg3, Arg4, N);

               --  Note that we do not set Is_Public here. That's because we
               --  only want to set it if there is no address clause, and we
               --  don't know that yet, so we delay that processing till
               --  freeze time.

               --  pragma Import completes deferred constants

               if Ekind (Def_Id) = E_Constant then
                  Set_Has_Completion (Def_Id);
               end if;

               --  It is not possible to import a constant of an unconstrained
               --  array type (e.g. string) because there is no simple way to
               --  write a meaningful subtype for it.

               if Is_Array_Type (Etype (Def_Id))
                 and then not Is_Constrained (Etype (Def_Id))
               then
                  Error_Msg_NE
                    ("imported constant& must have a constrained subtype",
                      N, Def_Id);
               end if;
            end if;

         elsif Is_Subprogram_Or_Generic_Subprogram (Def_Id) then

            --  If the name is overloaded, pragma applies to all of the denoted
            --  entities in the same declarative part, unless the pragma comes
            --  from an aspect specification or was generated by the compiler
            --  (such as for pragma Provide_Shift_Operators).

            Hom_Id := Def_Id;
            while Present (Hom_Id) loop

               Def_Id := Get_Base_Subprogram (Hom_Id);

               --  Ignore inherited subprograms because the pragma will apply
               --  to the parent operation, which is the one called.

               if Is_Overloadable (Def_Id)
                 and then Present (Alias (Def_Id))
               then
                  null;

               --  If it is not a subprogram, it must be in an outer scope and
               --  pragma does not apply.

               elsif not Is_Subprogram_Or_Generic_Subprogram (Def_Id) then
                  null;

               --  The pragma does not apply to primitives of interfaces

               elsif Is_Dispatching_Operation (Def_Id)
                 and then Present (Find_Dispatching_Type (Def_Id))
                 and then Is_Interface (Find_Dispatching_Type (Def_Id))
               then
                  null;

               --  Verify that the homonym is in the same declarative part (not
               --  just the same scope). If the pragma comes from an aspect
               --  specification we know that it is part of the declaration.

               elsif Parent (Unit_Declaration_Node (Def_Id)) /= Parent (N)
                 and then Nkind (Parent (N)) /= N_Compilation_Unit_Aux
                 and then not From_Aspect_Specification (N)
               then
                  exit;

               else
                  --  If the pragma comes from an aspect specification the
                  --  Is_Imported flag has already been set.

                  if not From_Aspect_Specification (N) then
                     Set_Imported (Def_Id);
                  end if;

                  --  Reject an Import applied to an abstract subprogram

                  if Is_Subprogram (Def_Id)
                    and then Is_Abstract_Subprogram (Def_Id)
                  then
                     Error_Msg_Sloc := Sloc (Def_Id);
                     Error_Msg_NE
                       ("cannot import abstract subprogram& declared#",
                        Arg2, Def_Id);
                  end if;

                  --  Special processing for Convention_Intrinsic

                  if C = Convention_Intrinsic then

                     --  Link_Name argument not allowed for intrinsic

                     Check_No_Link_Name;

                     Set_Is_Intrinsic_Subprogram (Def_Id);

                     --  If no external name is present, then check that this
                     --  is a valid intrinsic subprogram. If an external name
                     --  is present, then this is handled by the back end.

                     if No (Arg3) then
                        Check_Intrinsic_Subprogram
                          (Def_Id, Get_Pragma_Arg (Arg2));
                     end if;
                  end if;

                  --  Verify that the subprogram does not have a completion
                  --  through a renaming declaration. For other completions the
                  --  pragma appears as a too late representation.

                  declare
                     Decl : constant Node_Id := Unit_Declaration_Node (Def_Id);

                  begin
                     if Present (Decl)
                       and then Nkind (Decl) = N_Subprogram_Declaration
                       and then Present (Corresponding_Body (Decl))
                       and then Nkind (Unit_Declaration_Node
                                        (Corresponding_Body (Decl))) =
                                             N_Subprogram_Renaming_Declaration
                     then
                        Error_Msg_Sloc := Sloc (Def_Id);
                        Error_Msg_NE
                          ("cannot import&, renaming already provided for "
                           & "declaration #", N, Def_Id);
                     end if;
                  end;

                  --  If the pragma comes from an aspect specification, there
                  --  must be an Import aspect specified as well. In the rare
                  --  case where Import is set to False, the suprogram needs to
                  --  have a local completion.

                  declare
                     Imp_Aspect : constant Node_Id :=
                                    Find_Aspect (Def_Id, Aspect_Import);
                     Expr       : Node_Id;

                  begin
                     if Present (Imp_Aspect)
                       and then Present (Expression (Imp_Aspect))
                     then
                        Expr := Expression (Imp_Aspect);
                        Analyze_And_Resolve (Expr, Standard_Boolean);

                        if Is_Entity_Name (Expr)
                          and then Entity (Expr) = Standard_True
                        then
                           Set_Has_Completion (Def_Id);
                        end if;

                     --  If there is no expression, the default is True, as for
                     --  all boolean aspects. Same for the older pragma.

                     else
                        Set_Has_Completion (Def_Id);
                     end if;
                  end;

                  Process_Interface_Name (Def_Id, Arg3, Arg4, N);
               end if;

               if Is_Compilation_Unit (Hom_Id) then

                  --  Its possible homonyms are not affected by the pragma.
                  --  Such homonyms might be present in the context of other
                  --  units being compiled.

                  exit;

               elsif From_Aspect_Specification (N) then
                  exit;

               --  If the pragma was created by the compiler, then we don't
               --  want it to apply to other homonyms. This kind of case can
               --  occur when using pragma Provide_Shift_Operators, which
               --  generates implicit shift and rotate operators with Import
               --  pragmas that might apply to earlier explicit or implicit
               --  declarations marked with Import (for example, coming from
               --  an earlier pragma Provide_Shift_Operators for another type),
               --  and we don't generally want other homonyms being treated
               --  as imported or the pragma flagged as an illegal duplicate.

               elsif not Comes_From_Source (N) then
                  exit;

               else
                  Hom_Id := Homonym (Hom_Id);
               end if;
            end loop;

         --  Import a CPP class

         elsif C = Convention_CPP
           and then (Is_Record_Type (Def_Id)
                      or else Ekind (Def_Id) = E_Incomplete_Type)
         then
            if Ekind (Def_Id) = E_Incomplete_Type then
               if Present (Full_View (Def_Id)) then
                  Def_Id := Full_View (Def_Id);

               else
                  Error_Msg_N
                    ("cannot import 'C'P'P type before full declaration seen",
                     Get_Pragma_Arg (Arg2));

                  --  Although we have reported the error we decorate it as
                  --  CPP_Class to avoid reporting spurious errors

                  Set_Is_CPP_Class (Def_Id);
                  return;
               end if;
            end if;

            --  Types treated as CPP classes must be declared limited (note:
            --  this used to be a warning but there is no real benefit to it
            --  since we did effectively intend to treat the type as limited
            --  anyway).

            if not Is_Limited_Type (Def_Id) then
               Error_Msg_N
                 ("imported 'C'P'P type must be limited",
                  Get_Pragma_Arg (Arg2));
            end if;

            if Etype (Def_Id) /= Def_Id
              and then not Is_CPP_Class (Root_Type (Def_Id))
            then
               Error_Msg_N ("root type must be a 'C'P'P type", Arg1);
            end if;

            Set_Is_CPP_Class (Def_Id);

            --  Imported CPP types must not have discriminants (because C++
            --  classes do not have discriminants).

            if Has_Discriminants (Def_Id) then
               Error_Msg_N
                 ("imported 'C'P'P type cannot have discriminants",
                  First (Discriminant_Specifications
                          (Declaration_Node (Def_Id))));
            end if;

            --  Check that components of imported CPP types do not have default
            --  expressions. For private types this check is performed when the
            --  full view is analyzed (see Process_Full_View).

            if not Is_Private_Type (Def_Id) then
               Check_CPP_Type_Has_No_Defaults (Def_Id);
            end if;

         --  Import a CPP exception

         elsif C = Convention_CPP
           and then Ekind (Def_Id) = E_Exception
         then
            if No (Arg3) then
               Error_Pragma_Arg
                 ("'External_'Name arguments is required for 'Cpp exception",
                  Arg3);
            else
               --  As only a string is allowed, Check_Arg_Is_External_Name
               --  isn't called.

               Check_Arg_Is_OK_Static_Expression (Arg3, Standard_String);
            end if;

            if Present (Arg4) then
               Error_Pragma_Arg
                 ("Link_Name argument not allowed for imported Cpp exception",
                  Arg4);
            end if;

            --  Do not call Set_Interface_Name as the name of the exception
            --  shouldn't be modified (and in particular it shouldn't be
            --  the External_Name). For exceptions, the External_Name is the
            --  name of the RTTI structure.

            --  ??? Emit an error if pragma Import/Export_Exception is present

         elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then
            Check_No_Link_Name;
            Check_Arg_Count (3);
            Check_Arg_Is_OK_Static_Expression (Arg3, Standard_String);

            Process_Import_Predefined_Type;

         else
            Error_Pragma_Arg
              ("second argument of pragma% must be object, subprogram "
               & "or incomplete type",
               Arg2);
         end if;

         --  If this pragma applies to a compilation unit, then the unit, which
         --  is a subprogram, does not require (or allow) a body. We also do
         --  not need to elaborate imported procedures.

         if Nkind (Parent (N)) = N_Compilation_Unit_Aux then
            declare
               Cunit : constant Node_Id := Parent (Parent (N));
            begin
               Set_Body_Required (Cunit, False);
            end;
         end if;
      end Process_Import_Or_Interface;

      --------------------
      -- Process_Inline --
      --------------------

      procedure Process_Inline (Status : Inline_Status) is
         Applies : Boolean;
         Assoc   : Node_Id;
         Decl    : Node_Id;
         Subp    : Entity_Id;
         Subp_Id : Node_Id;

         Ghost_Error_Posted : Boolean := False;
         --  Flag set when an error concerning the illegal mix of Ghost and
         --  non-Ghost subprograms is emitted.

         Ghost_Id : Entity_Id := Empty;
         --  The entity of the first Ghost subprogram encountered while
         --  processing the arguments of the pragma.

         procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id);
         --  Verify the placement of pragma Inline_Always with respect to the
         --  initial declaration of subprogram Spec_Id.

         function Inlining_Not_Possible (Subp : Entity_Id) return Boolean;
         --  Returns True if it can be determined at this stage that inlining
         --  is not possible, for example if the body is available and contains
         --  exception handlers, we prevent inlining, since otherwise we can
         --  get undefined symbols at link time. This function also emits a
         --  warning if the pragma appears too late.
         --
         --  ??? is business with link symbols still valid, or does it relate
         --  to front end ZCX which is being phased out ???

         procedure Make_Inline (Subp : Entity_Id);
         --  Subp is the defining unit name of the subprogram declaration. If
         --  the pragma is valid, call Set_Inline_Flags on Subp, as well as on
         --  the corresponding body, if there is one present.

         procedure Set_Inline_Flags (Subp : Entity_Id);
         --  Set Has_Pragma_{No_Inline,Inline,Inline_Always} flag on Subp.
         --  Also set or clear Is_Inlined flag on Subp depending on Status.

         -----------------------------------
         -- Check_Inline_Always_Placement --
         -----------------------------------

         procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id) is
            Spec_Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id);

            function Compilation_Unit_OK return Boolean;
            pragma Inline (Compilation_Unit_OK);
            --  Determine whether pragma Inline_Always applies to a compatible
            --  compilation unit denoted by Spec_Id.

            function Declarative_List_OK return Boolean;
            pragma Inline (Declarative_List_OK);
            --  Determine whether the initial declaration of subprogram Spec_Id
            --  and the pragma appear in compatible declarative lists.

            function Subprogram_Body_OK return Boolean;
            pragma Inline (Subprogram_Body_OK);
            --  Determine whether pragma Inline_Always applies to a compatible
            --  subprogram body denoted by Spec_Id.

            -------------------------
            -- Compilation_Unit_OK --
            -------------------------

            function Compilation_Unit_OK return Boolean is
               Comp_Unit : constant Node_Id := Parent (Spec_Decl);

            begin
               --  The pragma appears after the initial declaration of a
               --  compilation unit.

               --    procedure Comp_Unit;
               --    pragma Inline_Always (Comp_Unit);

               --  Note that for compatibility reasons, the following case is
               --  also accepted.

               --    procedure Stand_Alone_Body_Comp_Unit is
               --       ...
               --    end Stand_Alone_Body_Comp_Unit;
               --    pragma Inline_Always (Stand_Alone_Body_Comp_Unit);

               return
                 Nkind (Comp_Unit) = N_Compilation_Unit
                   and then Present (Aux_Decls_Node (Comp_Unit))
                   and then Is_List_Member (N)
                   and then List_Containing (N) =
                              Pragmas_After (Aux_Decls_Node (Comp_Unit));
            end Compilation_Unit_OK;

            -------------------------
            -- Declarative_List_OK --
            -------------------------

            function Declarative_List_OK return Boolean is
               Context : constant Node_Id := Parent (Spec_Decl);

               Init_Decl : Node_Id;
               Init_List : List_Id;
               Prag_List : List_Id;

            begin
               --  Determine the proper initial declaration. In general this is
               --  the declaration node of the subprogram except when the input
               --  denotes a generic instantiation.

               --    procedure Inst is new Gen;
               --    pragma Inline_Always (Inst);

               --  In this case the original subprogram is moved inside an
               --  anonymous package while pragma Inline_Always remains at the
               --  level of the anonymous package. Use the declaration of the
               --  package because it reflects the placement of the original
               --  instantiation.

               --    package Anon_Pack is
               --       procedure Inst is ... end Inst;  --  original
               --    end Anon_Pack;

               --    procedure Inst renames Anon_Pack.Inst;
               --    pragma Inline_Always (Inst);

               if Is_Generic_Instance (Spec_Id) then
                  Init_Decl := Parent (Parent (Spec_Decl));
                  pragma Assert (Nkind (Init_Decl) = N_Package_Declaration);
               else
                  Init_Decl := Spec_Decl;
               end if;

               if Is_List_Member (Init_Decl) and then Is_List_Member (N) then
                  Init_List := List_Containing (Init_Decl);
                  Prag_List := List_Containing (N);

                  --  The pragma and then initial declaration appear within the
                  --  same declarative list.

                  if Init_List = Prag_List then
                     return True;

                  --  A special case of the above is when both the pragma and
                  --  the initial declaration appear in different lists of a
                  --  package spec, protected definition, or a task definition.

                  --    package Pack is
                  --       procedure Proc;
                  --    private
                  --       pragma Inline_Always (Proc);
                  --    end Pack;

                  elsif Nkind_In (Context, N_Package_Specification,
                                           N_Protected_Definition,
                                           N_Task_Definition)
                    and then Init_List = Visible_Declarations (Context)
                    and then Prag_List = Private_Declarations (Context)
                  then
                     return True;
                  end if;
               end if;

               return False;
            end Declarative_List_OK;

            ------------------------
            -- Subprogram_Body_OK --
            ------------------------

            function Subprogram_Body_OK return Boolean is
               Body_Decl : Node_Id;

            begin
               --  The pragma appears within the declarative list of a stand-
               --  alone subprogram body.

               --    procedure Stand_Alone_Body is
               --       pragma Inline_Always (Stand_Alone_Body);
               --    begin
               --       ...
               --    end Stand_Alone_Body;

               --  The compiler creates a dummy spec in this case, however the
               --  pragma remains within the declarative list of the body.

               if Nkind (Spec_Decl) = N_Subprogram_Declaration
                 and then not Comes_From_Source (Spec_Decl)
                 and then Present (Corresponding_Body (Spec_Decl))
               then
                  Body_Decl :=
                    Unit_Declaration_Node (Corresponding_Body (Spec_Decl));

                  if Present (Declarations (Body_Decl))
                    and then Is_List_Member (N)
                    and then List_Containing (N) = Declarations (Body_Decl)
                  then
                     return True;
                  end if;
               end if;

               return False;
            end Subprogram_Body_OK;

         --  Start of processing for Check_Inline_Always_Placement

         begin
            --  This check is relevant only for pragma Inline_Always

            if Pname /= Name_Inline_Always then
               return;

            --  Nothing to do when the pragma is internally generated on the
            --  assumption that it is properly placed.

            elsif not Comes_From_Source (N) then
               return;

            --  Nothing to do for internally generated subprograms that act
            --  as accidental homonyms of a source subprogram being inlined.

            elsif not Comes_From_Source (Spec_Id) then
               return;

            --  Nothing to do for generic formal subprograms that act as
            --  homonyms of another source subprogram being inlined.

            elsif Is_Formal_Subprogram (Spec_Id) then
               return;

            elsif Compilation_Unit_OK
              or else Declarative_List_OK
              or else Subprogram_Body_OK
            then
               return;
            end if;

            --  At this point it is known that the pragma applies to or appears
            --  within a completing body, a completing stub, or a subunit.

            Error_Msg_Name_1 := Pname;
            Error_Msg_Name_2 := Chars (Spec_Id);
            Error_Msg_Sloc   := Sloc (Spec_Id);

            Error_Msg_N
              ("pragma % must appear on initial declaration of subprogram "
               & "% defined #", N);
         end Check_Inline_Always_Placement;

         ---------------------------
         -- Inlining_Not_Possible --
         ---------------------------

         function Inlining_Not_Possible (Subp : Entity_Id) return Boolean is
            Decl  : constant Node_Id := Unit_Declaration_Node (Subp);
            Stats : Node_Id;

         begin
            if Nkind (Decl) = N_Subprogram_Body then
               Stats := Handled_Statement_Sequence (Decl);
               return Present (Exception_Handlers (Stats))
                 or else Present (At_End_Proc (Stats));

            elsif Nkind (Decl) = N_Subprogram_Declaration
              and then Present (Corresponding_Body (Decl))
            then
               if Analyzed (Corresponding_Body (Decl)) then
                  Error_Msg_N ("pragma appears too late, ignored??", N);
                  return True;

               --  If the subprogram is a renaming as body, the body is just a
               --  call to the renamed subprogram, and inlining is trivially
               --  possible.

               elsif
                 Nkind (Unit_Declaration_Node (Corresponding_Body (Decl))) =
                                             N_Subprogram_Renaming_Declaration
               then
                  return False;

               else
                  Stats :=
                    Handled_Statement_Sequence
                        (Unit_Declaration_Node (Corresponding_Body (Decl)));

                  return
                    Present (Exception_Handlers (Stats))
                      or else Present (At_End_Proc (Stats));
               end if;

            else
               --  If body is not available, assume the best, the check is
               --  performed again when compiling enclosing package bodies.

               return False;
            end if;
         end Inlining_Not_Possible;

         -----------------
         -- Make_Inline --
         -----------------

         procedure Make_Inline (Subp : Entity_Id) is
            Kind       : constant Entity_Kind := Ekind (Subp);
            Inner_Subp : Entity_Id   := Subp;

         begin
            --  Ignore if bad type, avoid cascaded error

            if Etype (Subp) = Any_Type then
               Applies := True;
               return;

            --  If inlining is not possible, for now do not treat as an error

            elsif Status /= Suppressed
              and then Front_End_Inlining
              and then Inlining_Not_Possible (Subp)
            then
               Applies := True;
               return;

            --  Here we have a candidate for inlining, but we must exclude
            --  derived operations. Otherwise we would end up trying to inline
            --  a phantom declaration, and the result would be to drag in a
            --  body which has no direct inlining associated with it. That
            --  would not only be inefficient but would also result in the
            --  backend doing cross-unit inlining in cases where it was
            --  definitely inappropriate to do so.

            --  However, a simple Comes_From_Source test is insufficient, since
            --  we do want to allow inlining of generic instances which also do
            --  not come from source. We also need to recognize specs generated
            --  by the front-end for bodies that carry the pragma. Finally,
            --  predefined operators do not come from source but are not
            --  inlineable either.

            elsif Is_Generic_Instance (Subp)
              or else Nkind (Parent (Parent (Subp))) = N_Subprogram_Declaration
            then
               null;

            elsif not Comes_From_Source (Subp)
              and then Scope (Subp) /= Standard_Standard
            then
               Applies := True;
               return;
            end if;

            --  The referenced entity must either be the enclosing entity, or
            --  an entity declared within the current open scope.

            if Present (Scope (Subp))
              and then Scope (Subp) /= Current_Scope
              and then Subp /= Current_Scope
            then
               Error_Pragma_Arg
                 ("argument of% must be entity in current scope", Assoc);
               return;
            end if;

            --  Processing for procedure, operator or function. If subprogram
            --  is aliased (as for an instance) indicate that the renamed
            --  entity (if declared in the same unit) is inlined.
            --  If this is the anonymous subprogram created for a subprogram
            --  instance, the inlining applies to it directly. Otherwise we
            --  retrieve it as the alias of the visible subprogram instance.

            if Is_Subprogram (Subp) then

               --  Ensure that pragma Inline_Always is associated with the
               --  initial declaration of the subprogram.

               Check_Inline_Always_Placement (Subp);

               if Is_Wrapper_Package (Scope (Subp)) then
                  Inner_Subp := Subp;
               else
                  Inner_Subp := Ultimate_Alias (Inner_Subp);
               end if;

               if In_Same_Source_Unit (Subp, Inner_Subp) then
                  Set_Inline_Flags (Inner_Subp);

                  Decl := Parent (Parent (Inner_Subp));

                  if Nkind (Decl) = N_Subprogram_Declaration
                    and then Present (Corresponding_Body (Decl))
                  then
                     Set_Inline_Flags (Corresponding_Body (Decl));

                  elsif Is_Generic_Instance (Subp)
                    and then Comes_From_Source (Subp)
                  then
                     --  Indicate that the body needs to be created for
                     --  inlining subsequent calls. The instantiation node
                     --  follows the declaration of the wrapper package
                     --  created for it. The subprogram that requires the
                     --  body is the anonymous one in the wrapper package.

                     if Scope (Subp) /= Standard_Standard
                       and then
                         Need_Subprogram_Instance_Body
                           (Next (Unit_Declaration_Node
                             (Scope (Alias (Subp)))), Subp)
                     then
                        null;
                     end if;

                  --  Inline is a program unit pragma (RM 10.1.5) and cannot
                  --  appear in a formal part to apply to a formal subprogram.
                  --  Do not apply check within an instance or a formal package
                  --  the test will have been applied to the original generic.

                  elsif Nkind (Decl) in N_Formal_Subprogram_Declaration
                    and then List_Containing (Decl) = List_Containing (N)
                    and then not In_Instance
                  then
                     Error_Msg_N
                       ("Inline cannot apply to a formal subprogram", N);

                  --  If Subp is a renaming, it is the renamed entity that
                  --  will appear in any call, and be inlined. However, for
                  --  ASIS uses it is convenient to indicate that the renaming
                  --  itself is an inlined subprogram, so that some gnatcheck
                  --  rules can be applied in the absence of expansion.

                  elsif Nkind (Decl) = N_Subprogram_Renaming_Declaration then
                     Set_Inline_Flags (Subp);
                  end if;
               end if;

               Applies := True;

            --  For a generic subprogram set flag as well, for use at the point
            --  of instantiation, to determine whether the body should be
            --  generated.

            elsif Is_Generic_Subprogram (Subp) then
               Set_Inline_Flags (Subp);
               Applies := True;

            --  Literals are by definition inlined

            elsif Kind = E_Enumeration_Literal then
               null;

            --  Anything else is an error

            else
               Error_Pragma_Arg
                 ("expect subprogram name for pragma%", Assoc);
            end if;
         end Make_Inline;

         ----------------------
         -- Set_Inline_Flags --
         ----------------------

         procedure Set_Inline_Flags (Subp : Entity_Id) is
         begin
            --  First set the Has_Pragma_XXX flags and issue the appropriate
            --  errors and warnings for suspicious combinations.

            if Prag_Id = Pragma_No_Inline then
               if Has_Pragma_Inline_Always (Subp) then
                  Error_Msg_N
                    ("Inline_Always and No_Inline are mutually exclusive", N);
               elsif Has_Pragma_Inline (Subp) then
                  Error_Msg_NE
                    ("Inline and No_Inline both specified for& ??",
                     N, Entity (Subp_Id));
               end if;

               Set_Has_Pragma_No_Inline (Subp);
            else
               if Prag_Id = Pragma_Inline_Always then
                  if Has_Pragma_No_Inline (Subp) then
                     Error_Msg_N
                       ("Inline_Always and No_Inline are mutually exclusive",
                        N);
                  end if;

                  Set_Has_Pragma_Inline_Always (Subp);
               else
                  if Has_Pragma_No_Inline (Subp) then
                     Error_Msg_NE
                       ("Inline and No_Inline both specified for& ??",
                        N, Entity (Subp_Id));
                  end if;
               end if;

               Set_Has_Pragma_Inline (Subp);
            end if;

            --  Then adjust the Is_Inlined flag. It can never be set if the
            --  subprogram is subject to pragma No_Inline.

            case Status is
               when Suppressed =>
                  Set_Is_Inlined (Subp, False);

               when Disabled =>
                  null;

               when Enabled =>
                  if not Has_Pragma_No_Inline (Subp) then
                     Set_Is_Inlined (Subp, True);
                  end if;
            end case;

            --  A pragma that applies to a Ghost entity becomes Ghost for the
            --  purposes of legality checks and removal of ignored Ghost code.

            Mark_Ghost_Pragma (N, Subp);

            --  Capture the entity of the first Ghost subprogram being
            --  processed for error detection purposes.

            if Is_Ghost_Entity (Subp) then
               if No (Ghost_Id) then
                  Ghost_Id := Subp;
               end if;

            --  Otherwise the subprogram is non-Ghost. It is illegal to mix
            --  references to Ghost and non-Ghost entities (SPARK RM 6.9).

            elsif Present (Ghost_Id) and then not Ghost_Error_Posted then
               Ghost_Error_Posted := True;

               Error_Msg_Name_1 := Pname;
               Error_Msg_N
                 ("pragma % cannot mention ghost and non-ghost subprograms",
                  N);

               Error_Msg_Sloc := Sloc (Ghost_Id);
               Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);

               Error_Msg_Sloc := Sloc (Subp);
               Error_Msg_NE ("\& # declared as non-ghost", N, Subp);
            end if;
         end Set_Inline_Flags;

      --  Start of processing for Process_Inline

      begin
         Check_No_Identifiers;
         Check_At_Least_N_Arguments (1);

         if Status = Enabled then
            Inline_Processing_Required := True;
         end if;

         Assoc := Arg1;
         while Present (Assoc) loop
            Subp_Id := Get_Pragma_Arg (Assoc);
            Analyze (Subp_Id);
            Applies := False;

            if Is_Entity_Name (Subp_Id) then
               Subp := Entity (Subp_Id);

               if Subp = Any_Id then

                  --  If previous error, avoid cascaded errors

                  Check_Error_Detected;
                  Applies := True;

               else
                  Make_Inline (Subp);

                  --  For the pragma case, climb homonym chain. This is
                  --  what implements allowing the pragma in the renaming
                  --  case, with the result applying to the ancestors, and
                  --  also allows Inline to apply to all previous homonyms.

                  if not From_Aspect_Specification (N) then
                     while Present (Homonym (Subp))
                       and then Scope (Homonym (Subp)) = Current_Scope
                     loop
                        Make_Inline (Homonym (Subp));
                        Subp := Homonym (Subp);
                     end loop;
                  end if;
               end if;
            end if;

            if not Applies then
               Error_Pragma_Arg ("inappropriate argument for pragma%", Assoc);
            end if;

            Next (Assoc);
         end loop;

         --  If the context is a package declaration, the pragma indicates
         --  that inlining will require the presence of the corresponding
         --  body. (this may be further refined).

         if not In_Instance
           and then Nkind (Unit (Cunit (Current_Sem_Unit))) =
                      N_Package_Declaration
         then
            Set_Body_Needed_For_Inlining (Cunit_Entity (Current_Sem_Unit));
         end if;
      end Process_Inline;

      ----------------------------
      -- Process_Interface_Name --
      ----------------------------

      procedure Process_Interface_Name
        (Subprogram_Def : Entity_Id;
         Ext_Arg        : Node_Id;
         Link_Arg       : Node_Id;
         Prag           : Node_Id)
      is
         Ext_Nam    : Node_Id;
         Link_Nam   : Node_Id;
         String_Val : String_Id;

         procedure Check_Form_Of_Interface_Name (SN : Node_Id);
         --  SN is a string literal node for an interface name. This routine
         --  performs some minimal checks that the name is reasonable. In
         --  particular that no spaces or other obviously incorrect characters
         --  appear. This is only a warning, since any characters are allowed.

         ----------------------------------
         -- Check_Form_Of_Interface_Name --
         ----------------------------------

         procedure Check_Form_Of_Interface_Name (SN : Node_Id) is
            S  : constant String_Id := Strval (Expr_Value_S (SN));
            SL : constant Nat       := String_Length (S);
            C  : Char_Code;

         begin
            if SL = 0 then
               Error_Msg_N ("interface name cannot be null string", SN);
            end if;

            for J in 1 .. SL loop
               C := Get_String_Char (S, J);

               --  Look for dubious character and issue unconditional warning.
               --  Definitely dubious if not in character range.

               if not In_Character_Range (C)

                 --  Commas, spaces and (back)slashes are dubious

                 or else Get_Character (C) = ','
                 or else Get_Character (C) = '\'
                 or else Get_Character (C) = ' '
                 or else Get_Character (C) = '/'
               then
                  Error_Msg
                    ("??interface name contains illegal character",
                     Sloc (SN) + Source_Ptr (J));
               end if;
            end loop;
         end Check_Form_Of_Interface_Name;

      --  Start of processing for Process_Interface_Name

      begin
         --  If we are looking at a pragma that comes from an aspect then it
         --  needs to have its corresponding aspect argument expressions
         --  analyzed in addition to the generated pragma so that aspects
         --  within generic units get properly resolved.

         if Present (Prag) and then From_Aspect_Specification (Prag) then
            declare
               Asp     : constant Node_Id := Corresponding_Aspect (Prag);
               Dummy_1 : Node_Id;
               Dummy_2 : Node_Id;
               Dummy_3 : Node_Id;
               EN      : Node_Id;
               LN      : Node_Id;

            begin
               --  Obtain all interfacing aspects used to construct the pragma

               Get_Interfacing_Aspects
                 (Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN);

               --  Analyze the expression of aspect External_Name

               if Present (EN) then
                  Analyze (Expression (EN));
               end if;

               --  Analyze the expressio of aspect Link_Name

               if Present (LN) then
                  Analyze (Expression (LN));
               end if;
            end;
         end if;

         if No (Link_Arg) then
            if No (Ext_Arg) then
               return;

            elsif Chars (Ext_Arg) = Name_Link_Name then
               Ext_Nam  := Empty;
               Link_Nam := Expression (Ext_Arg);

            else
               Check_Optional_Identifier (Ext_Arg, Name_External_Name);
               Ext_Nam  := Expression (Ext_Arg);
               Link_Nam := Empty;
            end if;

         else
            Check_Optional_Identifier (Ext_Arg,  Name_External_Name);
            Check_Optional_Identifier (Link_Arg, Name_Link_Name);
            Ext_Nam  := Expression (Ext_Arg);
            Link_Nam := Expression (Link_Arg);
         end if;

         --  Check expressions for external name and link name are static

         if Present (Ext_Nam) then
            Check_Arg_Is_OK_Static_Expression (Ext_Nam, Standard_String);
            Check_Form_Of_Interface_Name (Ext_Nam);

            --  Verify that external name is not the name of a local entity,
            --  which would hide the imported one and could lead to run-time
            --  surprises. The problem can only arise for entities declared in
            --  a package body (otherwise the external name is fully qualified
            --  and will not conflict).

            declare
               Nam : Name_Id;
               E   : Entity_Id;
               Par : Node_Id;

            begin
               if Prag_Id = Pragma_Import then
                  Nam := String_To_Name (Strval (Expr_Value_S (Ext_Nam)));
                  E   := Entity_Id (Get_Name_Table_Int (Nam));

                  if Nam /= Chars (Subprogram_Def)
                    and then Present (E)
                    and then not Is_Overloadable (E)
                    and then Is_Immediately_Visible (E)
                    and then not Is_Imported (E)
                    and then Ekind (Scope (E)) = E_Package
                  then
                     Par := Parent (E);
                     while Present (Par) loop
                        if Nkind (Par) = N_Package_Body then
                           Error_Msg_Sloc := Sloc (E);
                           Error_Msg_NE
                             ("imported entity is hidden by & declared#",
                              Ext_Arg, E);
                           exit;
                        end if;

                        Par := Parent (Par);
                     end loop;
                  end if;
               end if;
            end;
         end if;

         if Present (Link_Nam) then
            Check_Arg_Is_OK_Static_Expression (Link_Nam, Standard_String);
            Check_Form_Of_Interface_Name (Link_Nam);
         end if;

         --  If there is no link name, just set the external name

         if No (Link_Nam) then
            Link_Nam := Adjust_External_Name_Case (Expr_Value_S (Ext_Nam));

         --  For the Link_Name case, the given literal is preceded by an
         --  asterisk, which indicates to GCC that the given name should be
         --  taken literally, and in particular that no prepending of
         --  underlines should occur, even in systems where this is the
         --  normal default.

         else
            Start_String;
            Store_String_Char (Get_Char_Code ('*'));
            String_Val := Strval (Expr_Value_S (Link_Nam));
            Store_String_Chars (String_Val);
            Link_Nam :=
              Make_String_Literal (Sloc (Link_Nam),
                Strval => End_String);
         end if;

         --  Set the interface name. If the entity is a generic instance, use
         --  its alias, which is the callable entity.

         if Is_Generic_Instance (Subprogram_Def) then
            Set_Encoded_Interface_Name
              (Alias (Get_Base_Subprogram (Subprogram_Def)), Link_Nam);
         else
            Set_Encoded_Interface_Name
              (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
         end if;

         Check_Duplicated_Export_Name (Link_Nam);
      end Process_Interface_Name;

      -----------------------------------------
      -- Process_Interrupt_Or_Attach_Handler --
      -----------------------------------------

      procedure Process_Interrupt_Or_Attach_Handler is
         Handler  : constant Entity_Id := Entity (Get_Pragma_Arg (Arg1));
         Prot_Typ : constant Entity_Id := Scope (Handler);

      begin
         --  A pragma that applies to a Ghost entity becomes Ghost for the
         --  purposes of legality checks and removal of ignored Ghost code.

         Mark_Ghost_Pragma (N, Handler);
         Set_Is_Interrupt_Handler (Handler);

         pragma Assert (Ekind (Prot_Typ) = E_Protected_Type);

         Record_Rep_Item (Prot_Typ, N);

         --  Chain the pragma on the contract for completeness

         Add_Contract_Item (N, Handler);
      end Process_Interrupt_Or_Attach_Handler;

      --------------------------------------------------
      -- Process_Restrictions_Or_Restriction_Warnings --
      --------------------------------------------------

      --  Note: some of the simple identifier cases were handled in par-prag,
      --  but it is harmless (and more straightforward) to simply handle all
      --  cases here, even if it means we repeat a bit of work in some cases.

      procedure Process_Restrictions_Or_Restriction_Warnings
        (Warn : Boolean)
      is
         Arg   : Node_Id;
         R_Id  : Restriction_Id;
         Id    : Name_Id;
         Expr  : Node_Id;
         Val   : Uint;

      begin
         --  Ignore all Restrictions pragmas in CodePeer mode

         if CodePeer_Mode then
            return;
         end if;

         Check_Ada_83_Warning;
         Check_At_Least_N_Arguments (1);
         Check_Valid_Configuration_Pragma;

         Arg := Arg1;
         while Present (Arg) loop
            Id := Chars (Arg);
            Expr := Get_Pragma_Arg (Arg);

            --  Case of no restriction identifier present

            if Id = No_Name then
               if Nkind (Expr) /= N_Identifier then
                  Error_Pragma_Arg
                    ("invalid form for restriction", Arg);
               end if;

               R_Id :=
                 Get_Restriction_Id
                   (Process_Restriction_Synonyms (Expr));

               if R_Id not in All_Boolean_Restrictions then
                  Error_Msg_Name_1 := Pname;
                  Error_Msg_N
                    ("invalid restriction identifier&", Get_Pragma_Arg (Arg));

                  --  Check for possible misspelling

                  for J in Restriction_Id loop
                     declare
                        Rnm : constant String := Restriction_Id'Image (J);

                     begin
                        Name_Buffer (1 .. Rnm'Length) := Rnm;
                        Name_Len := Rnm'Length;
                        Set_Casing (All_Lower_Case);

                        if Is_Bad_Spelling_Of (Chars (Expr), Name_Enter) then
                           Set_Casing
                             (Identifier_Casing
                               (Source_Index (Current_Sem_Unit)));
                           Error_Msg_String (1 .. Rnm'Length) :=
                             Name_Buffer (1 .. Name_Len);
                           Error_Msg_Strlen := Rnm'Length;
                           Error_Msg_N -- CODEFIX
                             ("\possible misspelling of ""~""",
                              Get_Pragma_Arg (Arg));
                           exit;
                        end if;
                     end;
                  end loop;

                  raise Pragma_Exit;
               end if;

               if Implementation_Restriction (R_Id) then
                  Check_Restriction (No_Implementation_Restrictions, Arg);
               end if;

               --  Special processing for No_Elaboration_Code restriction

               if R_Id = No_Elaboration_Code then

                  --  Restriction is only recognized within a configuration
                  --  pragma file, or within a unit of the main extended
                  --  program. Note: the test for Main_Unit is needed to
                  --  properly include the case of configuration pragma files.

                  if not (Current_Sem_Unit = Main_Unit
                           or else In_Extended_Main_Source_Unit (N))
                  then
                     return;

                  --  Don't allow in a subunit unless already specified in
                  --  body or spec.

                  elsif Nkind (Parent (N)) = N_Compilation_Unit
                    and then Nkind (Unit (Parent (N))) = N_Subunit
                    and then not Restriction_Active (No_Elaboration_Code)
                  then
                     Error_Msg_N
                       ("invalid specification of ""No_Elaboration_Code""",
                        N);
                     Error_Msg_N
                       ("\restriction cannot be specified in a subunit", N);
                     Error_Msg_N
                       ("\unless also specified in body or spec", N);
                     return;

                  --  If we accept a No_Elaboration_Code restriction, then it
                  --  needs to be added to the configuration restriction set so
                  --  that we get proper application to other units in the main
                  --  extended source as required.

                  else
                     Add_To_Config_Boolean_Restrictions (No_Elaboration_Code);
                  end if;
               end if;

               --  If this is a warning, then set the warning unless we already
               --  have a real restriction active (we never want a warning to
               --  override a real restriction).

               if Warn then
                  if not Restriction_Active (R_Id) then
                     Set_Restriction (R_Id, N);
                     Restriction_Warnings (R_Id) := True;
                  end if;

               --  If real restriction case, then set it and make sure that the
               --  restriction warning flag is off, since a real restriction
               --  always overrides a warning.

               else
                  Set_Restriction (R_Id, N);
                  Restriction_Warnings (R_Id) := False;
               end if;

               --  Check for obsolescent restrictions in Ada 2005 mode

               if not Warn
                 and then Ada_Version >= Ada_2005
                 and then (R_Id = No_Asynchronous_Control
                            or else
                           R_Id = No_Unchecked_Deallocation
                            or else
                           R_Id = No_Unchecked_Conversion)
               then
                  Check_Restriction (No_Obsolescent_Features, N);
               end if;

               --  A very special case that must be processed here: pragma
               --  Restrictions (No_Exceptions) turns off all run-time
               --  checking. This is a bit dubious in terms of the formal
               --  language definition, but it is what is intended by RM
               --  H.4(12). Restriction_Warnings never affects generated code
               --  so this is done only in the real restriction case.

               --  Atomic_Synchronization is not a real check, so it is not
               --  affected by this processing).

               --  Ignore the effect of pragma Restrictions (No_Exceptions) on
               --  run-time checks in CodePeer and GNATprove modes: we want to
               --  generate checks for analysis purposes, as set respectively
               --  by -gnatC and -gnatd.F

               if not Warn
                 and then not (CodePeer_Mode or GNATprove_Mode)
                 and then R_Id = No_Exceptions
               then
                  for J in Scope_Suppress.Suppress'Range loop
                     if J /= Atomic_Synchronization then
                        Scope_Suppress.Suppress (J) := True;
                     end if;
                  end loop;
               end if;

            --  Case of No_Dependence => unit-name. Note that the parser
            --  already made the necessary entry in the No_Dependence table.

            elsif Id = Name_No_Dependence then
               if not OK_No_Dependence_Unit_Name (Expr) then
                  raise Pragma_Exit;
               end if;

            --  Case of No_Specification_Of_Aspect => aspect-identifier

            elsif Id = Name_No_Specification_Of_Aspect then
               declare
                  A_Id : Aspect_Id;

               begin
                  if Nkind (Expr) /= N_Identifier then
                     A_Id := No_Aspect;
                  else
                     A_Id := Get_Aspect_Id (Chars (Expr));
                  end if;

                  if A_Id = No_Aspect then
                     Error_Pragma_Arg ("invalid restriction name", Arg);
                  else
                     Set_Restriction_No_Specification_Of_Aspect (Expr, Warn);
                  end if;
               end;

            --  Case of No_Use_Of_Attribute => attribute-identifier

            elsif Id = Name_No_Use_Of_Attribute then
               if Nkind (Expr) /= N_Identifier
                 or else not Is_Attribute_Name (Chars (Expr))
               then
                  Error_Msg_N ("unknown attribute name??", Expr);

               else
                  Set_Restriction_No_Use_Of_Attribute (Expr, Warn);
               end if;

            --  Case of No_Use_Of_Entity => fully-qualified-name

            elsif Id = Name_No_Use_Of_Entity then

               --  Restriction is only recognized within a configuration
               --  pragma file, or within a unit of the main extended
               --  program. Note: the test for Main_Unit is needed to
               --  properly include the case of configuration pragma files.

               if Current_Sem_Unit = Main_Unit
                 or else In_Extended_Main_Source_Unit (N)
               then
                  if not OK_No_Dependence_Unit_Name (Expr) then
                     Error_Msg_N ("wrong form for entity name", Expr);
                  else
                     Set_Restriction_No_Use_Of_Entity
                       (Expr, Warn, No_Profile);
                  end if;
               end if;

            --  Case of No_Use_Of_Pragma => pragma-identifier

            elsif Id = Name_No_Use_Of_Pragma then
               if Nkind (Expr) /= N_Identifier
                 or else not Is_Pragma_Name (Chars (Expr))
               then
                  Error_Msg_N ("unknown pragma name??", Expr);
               else
                  Set_Restriction_No_Use_Of_Pragma (Expr, Warn);
               end if;

            --  All other cases of restriction identifier present

            else
               R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg));
               Analyze_And_Resolve (Expr, Any_Integer);

               if R_Id not in All_Parameter_Restrictions then
                  Error_Pragma_Arg
                    ("invalid restriction parameter identifier", Arg);

               elsif not Is_OK_Static_Expression (Expr) then
                  Flag_Non_Static_Expr
                    ("value must be static expression!", Expr);
                  raise Pragma_Exit;

               elsif not Is_Integer_Type (Etype (Expr))
                 or else Expr_Value (Expr) < 0
               then
                  Error_Pragma_Arg
                    ("value must be non-negative integer", Arg);
               end if;

               --  Restriction pragma is active

               Val := Expr_Value (Expr);

               if not UI_Is_In_Int_Range (Val) then
                  Error_Pragma_Arg
                    ("pragma ignored, value too large??", Arg);
               end if;

               --  Warning case. If the real restriction is active, then we
               --  ignore the request, since warning never overrides a real
               --  restriction. Otherwise we set the proper warning. Note that
               --  this circuit sets the warning again if it is already set,
               --  which is what we want, since the constant may have changed.

               if Warn then
                  if not Restriction_Active (R_Id) then
                     Set_Restriction
                       (R_Id, N, Integer (UI_To_Int (Val)));
                     Restriction_Warnings (R_Id) := True;
                  end if;

               --  Real restriction case, set restriction and make sure warning
               --  flag is off since real restriction always overrides warning.

               else
                  Set_Restriction (R_Id, N, Integer (UI_To_Int (Val)));
                  Restriction_Warnings (R_Id) := False;
               end if;
            end if;

            Next (Arg);
         end loop;
      end Process_Restrictions_Or_Restriction_Warnings;

      ---------------------------------
      -- Process_Suppress_Unsuppress --
      ---------------------------------

      --  Note: this procedure makes entries in the check suppress data
      --  structures managed by Sem. See spec of package Sem for full
      --  details on how we handle recording of check suppression.

      procedure Process_Suppress_Unsuppress (Suppress_Case : Boolean) is
         C    : Check_Id;
         E    : Entity_Id;
         E_Id : Node_Id;

         In_Package_Spec : constant Boolean :=
                             Is_Package_Or_Generic_Package (Current_Scope)
                               and then not In_Package_Body (Current_Scope);

         procedure Suppress_Unsuppress_Echeck (E : Entity_Id; C : Check_Id);
         --  Used to suppress a single check on the given entity

         --------------------------------
         -- Suppress_Unsuppress_Echeck --
         --------------------------------

         procedure Suppress_Unsuppress_Echeck (E : Entity_Id; C : Check_Id) is
         begin
            --  Check for error of trying to set atomic synchronization for
            --  a non-atomic variable.

            if C = Atomic_Synchronization
              and then not (Is_Atomic (E) or else Has_Atomic_Components (E))
            then
               Error_Msg_N
                 ("pragma & requires atomic type or variable",
                  Pragma_Identifier (Original_Node (N)));
            end if;

            Set_Checks_May_Be_Suppressed (E);

            if In_Package_Spec then
               Push_Global_Suppress_Stack_Entry
                 (Entity   => E,
                  Check    => C,
                  Suppress => Suppress_Case);
            else
               Push_Local_Suppress_Stack_Entry
                 (Entity   => E,
                  Check    => C,
                  Suppress => Suppress_Case);
            end if;

            --  If this is a first subtype, and the base type is distinct,
            --  then also set the suppress flags on the base type.

            if Is_First_Subtype (E) and then Etype (E) /= E then
               Suppress_Unsuppress_Echeck (Etype (E), C);
            end if;
         end Suppress_Unsuppress_Echeck;

      --  Start of processing for Process_Suppress_Unsuppress

      begin
         --  Ignore pragma Suppress/Unsuppress in CodePeer and GNATprove modes
         --  on user code: we want to generate checks for analysis purposes, as
         --  set respectively by -gnatC and -gnatd.F

         if Comes_From_Source (N)
           and then (CodePeer_Mode or GNATprove_Mode)
         then
            return;
         end if;

         --  Suppress/Unsuppress can appear as a configuration pragma, or in a
         --  declarative part or a package spec (RM 11.5(5)).

         if not Is_Configuration_Pragma then
            Check_Is_In_Decl_Part_Or_Package_Spec;
         end if;

         Check_At_Least_N_Arguments (1);
         Check_At_Most_N_Arguments (2);
         Check_No_Identifier (Arg1);
         Check_Arg_Is_Identifier (Arg1);

         C := Get_Check_Id (Chars (Get_Pragma_Arg (Arg1)));

         if C = No_Check_Id then
            Error_Pragma_Arg
              ("argument of pragma% is not valid check name", Arg1);
         end if;

         --  Warn that suppress of Elaboration_Check has no effect in SPARK

         if C = Elaboration_Check and then SPARK_Mode = On then
            Error_Pragma_Arg
              ("Suppress of Elaboration_Check ignored in SPARK??",
               "\elaboration checking rules are statically enforced "
               & "(SPARK RM 7.7)", Arg1);
         end if;

         --  One-argument case

         if Arg_Count = 1 then

            --  Make an entry in the local scope suppress table. This is the
            --  table that directly shows the current value of the scope
            --  suppress check for any check id value.

            if C = All_Checks then

               --  For All_Checks, we set all specific predefined checks with
               --  the exception of Elaboration_Check, which is handled
               --  specially because of not wanting All_Checks to have the
               --  effect of deactivating static elaboration order processing.
               --  Atomic_Synchronization is also not affected, since this is
               --  not a real check.

               for J in Scope_Suppress.Suppress'Range loop
                  if J /= Elaboration_Check
                       and then
                     J /= Atomic_Synchronization
                  then
                     Scope_Suppress.Suppress (J) := Suppress_Case;
                  end if;
               end loop;

            --  If not All_Checks, and predefined check, then set appropriate
            --  scope entry. Note that we will set Elaboration_Check if this
            --  is explicitly specified. Atomic_Synchronization is allowed
            --  only if internally generated and entity is atomic.

            elsif C in Predefined_Check_Id
              and then (not Comes_From_Source (N)
                         or else C /= Atomic_Synchronization)
            then
               Scope_Suppress.Suppress (C) := Suppress_Case;
            end if;

            --  Also make an entry in the Local_Entity_Suppress table

            Push_Local_Suppress_Stack_Entry
              (Entity   => Empty,
               Check    => C,
               Suppress => Suppress_Case);

         --  Case of two arguments present, where the check is suppressed for
         --  a specified entity (given as the second argument of the pragma)

         else
            --  This is obsolescent in Ada 2005 mode

            if Ada_Version >= Ada_2005 then
               Check_Restriction (No_Obsolescent_Features, Arg2);
            end if;

            Check_Optional_Identifier (Arg2, Name_On);
            E_Id := Get_Pragma_Arg (Arg2);
            Analyze (E_Id);

            if not Is_Entity_Name (E_Id) then
               Error_Pragma_Arg
                 ("second argument of pragma% must be entity name", Arg2);
            end if;

            E := Entity (E_Id);

            if E = Any_Id then
               return;
            end if;

            --  A pragma that applies to a Ghost entity becomes Ghost for the
            --  purposes of legality checks and removal of ignored Ghost code.

            Mark_Ghost_Pragma (N, E);

            --  Enforce RM 11.5(7) which requires that for a pragma that
            --  appears within a package spec, the named entity must be
            --  within the package spec. We allow the package name itself
            --  to be mentioned since that makes sense, although it is not
            --  strictly allowed by 11.5(7).

            if In_Package_Spec
              and then E /= Current_Scope
              and then Scope (E) /= Current_Scope
            then
               Error_Pragma_Arg
                 ("entity in pragma% is not in package spec (RM 11.5(7))",
                  Arg2);
            end if;

            --  Loop through homonyms. As noted below, in the case of a package
            --  spec, only homonyms within the package spec are considered.

            loop
               Suppress_Unsuppress_Echeck (E, C);

               if Is_Generic_Instance (E)
                 and then Is_Subprogram (E)
                 and then Present (Alias (E))
               then
                  Suppress_Unsuppress_Echeck (Alias (E), C);
               end if;

               --  Move to next homonym if not aspect spec case

               exit when From_Aspect_Specification (N);
               E := Homonym (E);
               exit when No (E);

               --  If we are within a package specification, the pragma only
               --  applies to homonyms in the same scope.

               exit when In_Package_Spec
                 and then Scope (E) /= Current_Scope;
            end loop;
         end if;
      end Process_Suppress_Unsuppress;

      -------------------------------
      -- Record_Independence_Check --
      -------------------------------

      procedure Record_Independence_Check (N : Node_Id; E : Entity_Id) is
         pragma Unreferenced (N, E);
      begin
         --  For GCC back ends the validation is done a priori
         --  ??? This code is dead, might be useful in the future

         --  if not AAMP_On_Target then
         --     return;
         --  end if;

         --  Independence_Checks.Append ((N, E));

         return;
      end Record_Independence_Check;

      ------------------
      -- Set_Exported --
      ------------------

      procedure Set_Exported (E : Entity_Id; Arg : Node_Id) is
      begin
         if Is_Imported (E) then
            Error_Pragma_Arg
              ("cannot export entity& that was previously imported", Arg);

         elsif Present (Address_Clause (E))
           and then not Relaxed_RM_Semantics
         then
            Error_Pragma_Arg
              ("cannot export entity& that has an address clause", Arg);
         end if;

         Set_Is_Exported (E);

         --  Generate a reference for entity explicitly, because the
         --  identifier may be overloaded and name resolution will not
         --  generate one.

         Generate_Reference (E, Arg);

         --  Deal with exporting non-library level entity

         if not Is_Library_Level_Entity (E) then

            --  Not allowed at all for subprograms

            if Is_Subprogram (E) then
               Error_Pragma_Arg ("local subprogram& cannot be exported", Arg);

            --  Otherwise set public and statically allocated

            else
               Set_Is_Public (E);
               Set_Is_Statically_Allocated (E);

               --  Warn if the corresponding W flag is set

               if Warn_On_Export_Import

                 --  Only do this for something that was in the source. Not
                 --  clear if this can be False now (there used for sure to be
                 --  cases on some systems where it was False), but anyway the
                 --  test is harmless if not needed, so it is retained.

                 and then Comes_From_Source (Arg)
               then
                  Error_Msg_NE
                    ("?x?& has been made static as a result of Export",
                     Arg, E);
                  Error_Msg_N
                    ("\?x?this usage is non-standard and non-portable",
                     Arg);
               end if;
            end if;
         end if;

         if Warn_On_Export_Import and then Is_Type (E) then
            Error_Msg_NE ("exporting a type has no effect?x?", Arg, E);
         end if;

         if Warn_On_Export_Import and Inside_A_Generic then
            Error_Msg_NE
              ("all instances of& will have the same external name?x?",
               Arg, E);
         end if;
      end Set_Exported;

      ----------------------------------------------
      -- Set_Extended_Import_Export_External_Name --
      ----------------------------------------------

      procedure Set_Extended_Import_Export_External_Name
        (Internal_Ent : Entity_Id;
         Arg_External : Node_Id)
      is
         Old_Name : constant Node_Id := Interface_Name (Internal_Ent);
         New_Name : Node_Id;

      begin
         if No (Arg_External) then
            return;
         end if;

         Check_Arg_Is_External_Name (Arg_External);

         if Nkind (Arg_External) = N_String_Literal then
            if String_Length (Strval (Arg_External)) = 0 then
               return;
            else
               New_Name := Adjust_External_Name_Case (Arg_External);
            end if;

         elsif Nkind (Arg_External) = N_Identifier then
            New_Name := Get_Default_External_Name (Arg_External);

         --  Check_Arg_Is_External_Name should let through only identifiers and
         --  string literals or static string expressions (which are folded to
         --  string literals).

         else
            raise Program_Error;
         end if;

         --  If we already have an external name set (by a prior normal Import
         --  or Export pragma), then the external names must match

         if Present (Interface_Name (Internal_Ent)) then

            --  Ignore mismatching names in CodePeer mode, to support some
            --  old compilers which would export the same procedure under
            --  different names, e.g:
            --     procedure P;
            --     pragma Export_Procedure (P, "a");
            --     pragma Export_Procedure (P, "b");

            if CodePeer_Mode then
               return;
            end if;

            Check_Matching_Internal_Names : declare
               S1 : constant String_Id := Strval (Old_Name);
               S2 : constant String_Id := Strval (New_Name);

               procedure Mismatch;
               pragma No_Return (Mismatch);
               --  Called if names do not match

               --------------
               -- Mismatch --
               --------------

               procedure Mismatch is
               begin
                  Error_Msg_Sloc := Sloc (Old_Name);
                  Error_Pragma_Arg
                    ("external name does not match that given #",
                     Arg_External);
               end Mismatch;

            --  Start of processing for Check_Matching_Internal_Names

            begin
               if String_Length (S1) /= String_Length (S2) then
                  Mismatch;

               else
                  for J in 1 .. String_Length (S1) loop
                     if Get_String_Char (S1, J) /= Get_String_Char (S2, J) then
                        Mismatch;
                     end if;
                  end loop;
               end if;
            end Check_Matching_Internal_Names;

         --  Otherwise set the given name

         else
            Set_Encoded_Interface_Name (Internal_Ent, New_Name);
            Check_Duplicated_Export_Name (New_Name);
         end if;
      end Set_Extended_Import_Export_External_Name;

      ------------------
      -- Set_Imported --
      ------------------

      procedure Set_Imported (E : Entity_Id) is
      begin
         --  Error message if already imported or exported

         if Is_Exported (E) or else Is_Imported (E) then

            --  Error if being set Exported twice

            if Is_Exported (E) then
               Error_Msg_NE ("entity& was previously exported", N, E);

            --  Ignore error in CodePeer mode where we treat all imported
            --  subprograms as unknown.

            elsif CodePeer_Mode then
               goto OK;

            --  OK if Import/Interface case

            elsif Import_Interface_Present (N) then
               goto OK;

            --  Error if being set Imported twice

            else
               Error_Msg_NE ("entity& was previously imported", N, E);
            end if;

            Error_Msg_Name_1 := Pname;
            Error_Msg_N
              ("\(pragma% applies to all previous entities)", N);

            Error_Msg_Sloc  := Sloc (E);
            Error_Msg_NE ("\import not allowed for& declared#", N, E);

         --  Here if not previously imported or exported, OK to import

         else
            Set_Is_Imported (E);

            --  For subprogram, set Import_Pragma field

            if Is_Subprogram (E) then
               Set_Import_Pragma (E, N);
            end if;

            --  If the entity is an object that is not at the library level,
            --  then it is statically allocated. We do not worry about objects
            --  with address clauses in this context since they are not really
            --  imported in the linker sense.

            if Is_Object (E)
              and then not Is_Library_Level_Entity (E)
              and then No (Address_Clause (E))
            then
               Set_Is_Statically_Allocated (E);
            end if;
         end if;

         <<OK>> null;
      end Set_Imported;

      -------------------------
      -- Set_Mechanism_Value --
      -------------------------

      --  Note: the mechanism name has not been analyzed (and cannot indeed be
      --  analyzed, since it is semantic nonsense), so we get it in the exact
      --  form created by the parser.

      procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
         procedure Bad_Mechanism;
         pragma No_Return (Bad_Mechanism);
         --  Signal bad mechanism name

         -------------------
         -- Bad_Mechanism --
         -------------------

         procedure Bad_Mechanism is
         begin
            Error_Pragma_Arg ("unrecognized mechanism name", Mech_Name);
         end Bad_Mechanism;

      --  Start of processing for Set_Mechanism_Value

      begin
         if Mechanism (Ent) /= Default_Mechanism then
            Error_Msg_NE
              ("mechanism for & has already been set", Mech_Name, Ent);
         end if;

         --  MECHANISM_NAME ::= value | reference

         if Nkind (Mech_Name) = N_Identifier then
            if Chars (Mech_Name) = Name_Value then
               Set_Mechanism (Ent, By_Copy);
               return;

            elsif Chars (Mech_Name) = Name_Reference then
               Set_Mechanism (Ent, By_Reference);
               return;

            elsif Chars (Mech_Name) = Name_Copy then
               Error_Pragma_Arg
                 ("bad mechanism name, Value assumed", Mech_Name);

            else
               Bad_Mechanism;
            end if;

         else
            Bad_Mechanism;
         end if;
      end Set_Mechanism_Value;

      --------------------------
      -- Set_Rational_Profile --
      --------------------------

      --  The Rational profile includes Implicit_Packing, Use_Vads_Size, and
      --  extension to the semantics of renaming declarations.

      procedure Set_Rational_Profile is
      begin
         Implicit_Packing     := True;
         Overriding_Renamings := True;
         Use_VADS_Size        := True;
      end Set_Rational_Profile;

      ---------------------------
      -- Set_Ravenscar_Profile --
      ---------------------------

      --  The tasks to be done here are

      --    Set required policies

      --      pragma Task_Dispatching_Policy (FIFO_Within_Priorities)
      --        (For Ravenscar and GNAT_Extended_Ravenscar profiles)
      --      pragma Task_Dispatching_Policy (EDF_Across_Priorities)
      --        (For GNAT_Ravenscar_EDF profile)
      --      pragma Locking_Policy (Ceiling_Locking)

      --    Set Detect_Blocking mode

      --    Set required restrictions (see System.Rident for detailed list)

      --    Set the No_Dependence rules
      --      No_Dependence => Ada.Asynchronous_Task_Control
      --      No_Dependence => Ada.Calendar
      --      No_Dependence => Ada.Execution_Time.Group_Budget
      --      No_Dependence => Ada.Execution_Time.Timers
      --      No_Dependence => Ada.Task_Attributes
      --      No_Dependence => System.Multiprocessors.Dispatching_Domains

      procedure Set_Ravenscar_Profile (Profile : Profile_Name; N : Node_Id) is
         procedure Set_Error_Msg_To_Profile_Name;
         --  Set Error_Msg_String and Error_Msg_Strlen to the name of the
         --  profile.

         -----------------------------------
         -- Set_Error_Msg_To_Profile_Name --
         -----------------------------------

         procedure Set_Error_Msg_To_Profile_Name is
            Prof_Nam : constant Node_Id :=
                         Get_Pragma_Arg
                           (First (Pragma_Argument_Associations (N)));

         begin
            Get_Name_String (Chars (Prof_Nam));
            Adjust_Name_Case (Global_Name_Buffer, Sloc (Prof_Nam));
            Error_Msg_Strlen := Name_Len;
            Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
         end Set_Error_Msg_To_Profile_Name;

         --  Local variables

         Nod     : Node_Id;
         Pref    : Node_Id;
         Pref_Id : Node_Id;
         Sel_Id  : Node_Id;

         Profile_Dispatching_Policy : Character;

      --  Start of processing for Set_Ravenscar_Profile

      begin
         --  pragma Task_Dispatching_Policy (EDF_Across_Priorities)

         if Profile = GNAT_Ravenscar_EDF then
            Profile_Dispatching_Policy := 'E';

         --  pragma Task_Dispatching_Policy (FIFO_Within_Priorities)

         else
            Profile_Dispatching_Policy := 'F';
         end if;

         if Task_Dispatching_Policy /= ' '
           and then Task_Dispatching_Policy /= Profile_Dispatching_Policy
         then
            Error_Msg_Sloc := Task_Dispatching_Policy_Sloc;
            Set_Error_Msg_To_Profile_Name;
            Error_Pragma ("Profile (~) incompatible with policy#");

         --  Set the FIFO_Within_Priorities policy, but always preserve
         --  System_Location since we like the error message with the run time
         --  name.

         else
            Task_Dispatching_Policy := Profile_Dispatching_Policy;

            if Task_Dispatching_Policy_Sloc /= System_Location then
               Task_Dispatching_Policy_Sloc := Loc;
            end if;
         end if;

         --  pragma Locking_Policy (Ceiling_Locking)

         if Locking_Policy /= ' '
           and then Locking_Policy /= 'C'
         then
            Error_Msg_Sloc := Locking_Policy_Sloc;
            Set_Error_Msg_To_Profile_Name;
            Error_Pragma ("Profile (~) incompatible with policy#");

         --  Set the Ceiling_Locking policy, but preserve System_Location since
         --  we like the error message with the run time name.

         else
            Locking_Policy := 'C';

            if Locking_Policy_Sloc /= System_Location then
               Locking_Policy_Sloc := Loc;
            end if;
         end if;

         --  pragma Detect_Blocking

         Detect_Blocking := True;

         --  Set the corresponding restrictions

         Set_Profile_Restrictions
           (Profile, N, Warn => Treat_Restrictions_As_Warnings);

         --  Set the No_Dependence restrictions

         --  The following No_Dependence restrictions:
         --    No_Dependence => Ada.Asynchronous_Task_Control
         --    No_Dependence => Ada.Calendar
         --    No_Dependence => Ada.Task_Attributes
         --  are already set by previous call to Set_Profile_Restrictions.

         --  Set the following restrictions which were added to Ada 2005:
         --    No_Dependence => Ada.Execution_Time.Group_Budget
         --    No_Dependence => Ada.Execution_Time.Timers

         if Ada_Version >= Ada_2005 then
            Pref_Id := Make_Identifier (Loc, Name_Find ("ada"));
            Sel_Id  := Make_Identifier (Loc, Name_Find ("execution_time"));

            Pref :=
              Make_Selected_Component
                (Sloc          => Loc,
                 Prefix        => Pref_Id,
                 Selector_Name => Sel_Id);

            Sel_Id := Make_Identifier (Loc, Name_Find ("group_budgets"));

            Nod :=
              Make_Selected_Component
                (Sloc          => Loc,
                 Prefix        => Pref,
                 Selector_Name => Sel_Id);

            Set_Restriction_No_Dependence
              (Unit    => Nod,
               Warn    => Treat_Restrictions_As_Warnings,
               Profile => Ravenscar);

            Sel_Id := Make_Identifier (Loc, Name_Find ("timers"));

            Nod :=
              Make_Selected_Component
                (Sloc          => Loc,
                 Prefix        => Pref,
                 Selector_Name => Sel_Id);

            Set_Restriction_No_Dependence
              (Unit    => Nod,
               Warn    => Treat_Restrictions_As_Warnings,
               Profile => Ravenscar);
         end if;

         --  Set the following restriction which was added to Ada 2012 (see
         --  AI-0171):
         --    No_Dependence => System.Multiprocessors.Dispatching_Domains

         if Ada_Version >= Ada_2012 then
            Pref_Id := Make_Identifier (Loc, Name_Find ("system"));
            Sel_Id  := Make_Identifier (Loc, Name_Find ("multiprocessors"));

            Pref :=
              Make_Selected_Component
                (Sloc          => Loc,
                 Prefix        => Pref_Id,
                 Selector_Name => Sel_Id);

            Sel_Id := Make_Identifier (Loc, Name_Find ("dispatching_domains"));

            Nod :=
              Make_Selected_Component
                (Sloc          => Loc,
                 Prefix        => Pref,
                 Selector_Name => Sel_Id);

            Set_Restriction_No_Dependence
              (Unit    => Nod,
               Warn    => Treat_Restrictions_As_Warnings,
               Profile => Ravenscar);
         end if;
      end Set_Ravenscar_Profile;

      -----------------------------------
      -- Validate_Acc_Condition_Clause --
      -----------------------------------

      procedure Validate_Acc_Condition_Clause (Clause : Node_Id) is
      begin
         Analyze_And_Resolve (Clause);

         if not Is_Boolean_Type (Etype (Clause)) then
            Error_Pragma ("expected a boolean");
         end if;
      end Validate_Acc_Condition_Clause;

      ------------------------------
      -- Validate_Acc_Data_Clause --
      ------------------------------

      procedure Validate_Acc_Data_Clause (Clause : Node_Id) is
         Expr : Node_Id;

      begin
         Expr := Acc_First (Clause);
         while Present (Expr) loop
            if Nkind (Expr) /= N_Identifier then
               Error_Pragma ("expected an identifer");
            end if;

            Analyze_And_Resolve (Expr);

            Expr := Acc_Next (Expr);
         end loop;
      end Validate_Acc_Data_Clause;

      ----------------------------------
      -- Validate_Acc_Int_Expr_Clause --
      ----------------------------------

      procedure Validate_Acc_Int_Expr_Clause (Clause : Node_Id) is
      begin
         Analyze_And_Resolve (Clause);

         if not Is_Integer_Type (Etype (Clause)) then
            Error_Pragma_Arg ("expected an integer", Clause);
         end if;
      end Validate_Acc_Int_Expr_Clause;

      ---------------------------------------
      -- Validate_Acc_Int_Expr_List_Clause --
      ---------------------------------------

      procedure Validate_Acc_Int_Expr_List_Clause (Clause : Node_Id) is
         Expr : Node_Id;

      begin
         Expr := Acc_First (Clause);
         while Present (Expr) loop
            Analyze_And_Resolve (Expr);

            if not Is_Integer_Type (Etype (Expr)) then
               Error_Pragma ("expected an integer");
            end if;

            Expr := Acc_Next (Expr);
         end loop;
      end Validate_Acc_Int_Expr_List_Clause;

      --------------------------------
      -- Validate_Acc_Loop_Collapse --
      --------------------------------

      procedure Validate_Acc_Loop_Collapse (Clause : Node_Id) is
         Count    : Uint;
         Par_Loop : Node_Id;
         Stmt     : Node_Id;

      begin
         --  Make sure the argument is a positive integer

         Analyze_And_Resolve (Clause);

         Count := Static_Integer (Clause);
         if Count = No_Uint or else Count < 1 then
            Error_Pragma_Arg ("expected a positive integer", Clause);
         end if;

         --  Then, make sure we have at least Count-1 tightly-nested loops
         --  (i.e. loops with no statements in between).

         Par_Loop := Parent (Parent (Parent (Clause)));
         Stmt     := First (Statements (Par_Loop));

         --  Skip first pragmas in the parent loop

         while Present (Stmt) and then Nkind (Stmt) = N_Pragma loop
            Next (Stmt);
         end loop;

         if not Present (Next (Stmt)) then
            while Nkind (Stmt) = N_Loop_Statement and Count > 1 loop
               Stmt := First (Statements (Stmt));
               exit when Present (Next (Stmt));

               Count := Count - 1;
            end loop;
         end if;

         if Count > 1 then
            Error_Pragma_Arg
              ("Collapse argument too high or loops not tightly nested",
               Clause);
         end if;
      end Validate_Acc_Loop_Collapse;

      ----------------------------
      -- Validate_Acc_Loop_Gang --
      ----------------------------

      procedure Validate_Acc_Loop_Gang (Clause : Node_Id) is
      begin
         Error_Pragma_Arg ("Loop_Gang not implemented", Clause);
      end Validate_Acc_Loop_Gang;

      ------------------------------
      -- Validate_Acc_Loop_Vector --
      ------------------------------

      procedure Validate_Acc_Loop_Vector (Clause : Node_Id) is
      begin
         Error_Pragma_Arg ("Loop_Vector not implemented", Clause);
      end Validate_Acc_Loop_Vector;

      -------------------------------
      --  Validate_Acc_Loop_Worker --
      -------------------------------

      procedure Validate_Acc_Loop_Worker (Clause : Node_Id) is
      begin
         Error_Pragma_Arg ("Loop_Worker not implemented", Clause);
      end Validate_Acc_Loop_Worker;

      ---------------------------------
      -- Validate_Acc_Name_Reduction --
      ---------------------------------

      procedure Validate_Acc_Name_Reduction (Clause : Node_Id) is

         --  ??? On top of the following operations, the OpenAcc spec adds the
         --  "bitwise and", "bitwise or" and modulo for C and ".eqv" and
         --  ".neqv" for Fortran. Can we, should we and how do we support them
         --  in Ada?

         type Reduction_Op is (Add_Op, Mul_Op, Max_Op, Min_Op, And_Op, Or_Op);

         function To_Reduction_Op (Op : String) return Reduction_Op;
         --  Convert operator Op described by a String into its corresponding
         --  enumeration value.

         ---------------------
         -- To_Reduction_Op --
         ---------------------

         function To_Reduction_Op (Op : String) return Reduction_Op is
         begin
            if Op = "+" then
               return Add_Op;

            elsif Op = "*" then
               return Mul_Op;

            elsif Op = "max" then
               return Max_Op;

            elsif Op = "min" then
               return Min_Op;

            elsif Op = "and" then
               return And_Op;

            elsif Op = "or" then
               return Or_Op;

            else
               Error_Pragma ("unsuported reduction operation");
            end if;
         end To_Reduction_Op;

         --  Local variables

         Seen : constant Elist_Id := New_Elmt_List;

         Expr      : Node_Id;
         Reduc_Op  : Node_Id;
         Reduc_Var : Node_Id;

      --  Start of processing for Validate_Acc_Name_Reduction

      begin
         --  Reduction operations appear in the following form:
         --    ("+" => (a, b), "*" => c)

         Expr := First (Component_Associations (Clause));
         while Present (Expr) loop
            Reduc_Op := First (Choices (Expr));
            String_To_Name_Buffer (Strval (Reduc_Op));

            case To_Reduction_Op (Name_Buffer (1 .. Name_Len)) is
               when Add_Op
                  | Mul_Op
                  | Max_Op
                  | Min_Op
               =>
                  Reduc_Var := Acc_First (Expression (Expr));
                  while Present (Reduc_Var) loop
                     Analyze_And_Resolve (Reduc_Var);

                     if Contains (Seen, Entity (Reduc_Var)) then
                        Error_Pragma ("variable used in multiple reductions");

                     else
                        if Nkind (Reduc_Var) /= N_Identifier
                          or not Is_Numeric_Type (Etype (Reduc_Var))
                        then
                           Error_Pragma
                             ("expected an identifier for a Numeric");
                        end if;

                        Append_Elmt (Entity (Reduc_Var), Seen);
                     end if;

                     Reduc_Var := Acc_Next (Reduc_Var);
                  end loop;

               when And_Op
                  | Or_Op
               =>
                  Reduc_Var := Acc_First (Expression (Expr));
                  while Present (Reduc_Var) loop
                     Analyze_And_Resolve (Reduc_Var);

                     if Contains (Seen, Entity (Reduc_Var)) then
                        Error_Pragma ("variable used in multiple reductions");

                     else
                        if Nkind (Reduc_Var) /= N_Identifier
                          or not Is_Boolean_Type (Etype (Reduc_Var))
                        then
                           Error_Pragma
                             ("expected a variable of type boolean");
                        end if;

                        Append_Elmt (Entity (Reduc_Var), Seen);
                     end if;

                     Reduc_Var := Acc_Next (Reduc_Var);
                  end loop;
            end case;

            Next (Expr);
         end loop;
      end Validate_Acc_Name_Reduction;

      -----------------------------------
      -- Validate_Acc_Size_Expressions --
      -----------------------------------

      procedure Validate_Acc_Size_Expressions (Clause : Node_Id) is
         function Validate_Size_Expr (Expr : Node_Id) return Boolean;
         --  A size expr is either an integer expression or "*"

         ------------------------
         -- Validate_Size_Expr --
         ------------------------

         function Validate_Size_Expr (Expr : Node_Id) return Boolean is
         begin
            if Nkind (Expr) = N_Operator_Symbol then
               return Get_String_Char (Strval (Expr), 1) = Get_Char_Code ('*');
            end if;

            Analyze_And_Resolve (Expr);

            return Is_Integer_Type (Etype (Expr));
         end Validate_Size_Expr;

         --  Local variables

         Expr : Node_Id;

      --  Start of processing for Validate_Acc_Size_Expressions

      begin
         Expr := Acc_First (Clause);
         while Present (Expr) loop
            if not Validate_Size_Expr (Expr) then
               Error_Pragma
                 ("Size expressions should be either integers or '*'");
            end if;

            Expr := Acc_Next (Expr);
         end loop;
      end Validate_Acc_Size_Expressions;

   --  Start of processing for Analyze_Pragma

   begin
      --  The following code is a defense against recursion. Not clear that
      --  this can happen legitimately, but perhaps some error situations can
      --  cause it, and we did see this recursion during testing.

      if Analyzed (N) then
         return;
      else
         Set_Analyzed (N);
      end if;

      Check_Restriction_No_Use_Of_Pragma (N);

      --  Ignore pragma if Ignore_Pragma applies. Also ignore pragma
      --  Default_Scalar_Storage_Order if the -gnatI switch was given.

      if Should_Ignore_Pragma_Sem (N)
        or else (Prag_Id = Pragma_Default_Scalar_Storage_Order
                  and then Ignore_Rep_Clauses)
      then
         return;
      end if;

      --  Deal with unrecognized pragma

      if not Is_Pragma_Name (Pname) then
         if Warn_On_Unrecognized_Pragma then
            Error_Msg_Name_1 := Pname;
            Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N));

            for PN in First_Pragma_Name .. Last_Pragma_Name loop
               if Is_Bad_Spelling_Of (Pname, PN) then
                  Error_Msg_Name_1 := PN;
                  Error_Msg_N -- CODEFIX
                    ("\?g?possible misspelling of %!", Pragma_Identifier (N));
                  exit;
               end if;
            end loop;
         end if;

         return;
      end if;

      --  Here to start processing for recognized pragma

      Pname := Original_Aspect_Pragma_Name (N);

      --  Capture setting of Opt.Uneval_Old

      case Opt.Uneval_Old is
         when 'A' =>
            Set_Uneval_Old_Accept (N);

         when 'E' =>
            null;

         when 'W' =>
            Set_Uneval_Old_Warn (N);

         when others =>
            raise Program_Error;
      end case;

      --  Check applicable policy. We skip this if Is_Checked or Is_Ignored
      --  is already set, indicating that we have already checked the policy
      --  at the right point. This happens for example in the case of a pragma
      --  that is derived from an Aspect.

      if Is_Ignored (N) or else Is_Checked (N) then
         null;

      --  For a pragma that is a rewriting of another pragma, copy the
      --  Is_Checked/Is_Ignored status from the rewritten pragma.

      elsif Is_Rewrite_Substitution (N)
        and then Nkind (Original_Node (N)) = N_Pragma
      then
         Set_Is_Ignored (N, Is_Ignored (Original_Node (N)));
         Set_Is_Checked (N, Is_Checked (Original_Node (N)));

      --  Otherwise query the applicable policy at this point

      else
         Check_Applicable_Policy (N);

         --  If pragma is disabled, rewrite as NULL and skip analysis

         if Is_Disabled (N) then
            Rewrite (N, Make_Null_Statement (Loc));
            Analyze (N);
            raise Pragma_Exit;
         end if;
      end if;

      --  Preset arguments

      Arg_Count := 0;
      Arg1      := Empty;
      Arg2      := Empty;
      Arg3      := Empty;
      Arg4      := Empty;

      if Present (Pragma_Argument_Associations (N)) then
         Arg_Count := List_Length (Pragma_Argument_Associations (N));
         Arg1 := First (Pragma_Argument_Associations (N));

         if Present (Arg1) then
            Arg2 := Next (Arg1);

            if Present (Arg2) then
               Arg3 := Next (Arg2);

               if Present (Arg3) then
                  Arg4 := Next (Arg3);
               end if;
            end if;
         end if;
      end if;

      --  An enumeration type defines the pragmas that are supported by the
      --  implementation. Get_Pragma_Id (in package Prag) transforms a name
      --  into the corresponding enumeration value for the following case.

      case Prag_Id is

         -----------------
         -- Abort_Defer --
         -----------------

         --  pragma Abort_Defer;

         when Pragma_Abort_Defer =>
            GNAT_Pragma;
            Check_Arg_Count (0);

            --  The only required semantic processing is to check the
            --  placement. This pragma must appear at the start of the
            --  statement sequence of a handled sequence of statements.

            if Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements
              or else N /= First (Statements (Parent (N)))
            then
               Pragma_Misplaced;
            end if;

         --------------------
         -- Abstract_State --
         --------------------

         --  pragma Abstract_State (ABSTRACT_STATE_LIST);

         --  ABSTRACT_STATE_LIST ::=
         --     null
         --  |  STATE_NAME_WITH_OPTIONS
         --  | (STATE_NAME_WITH_OPTIONS {, STATE_NAME_WITH_OPTIONS})

         --  STATE_NAME_WITH_OPTIONS ::=
         --     STATE_NAME
         --  | (STATE_NAME with OPTION_LIST)

         --  OPTION_LIST ::= OPTION {, OPTION}

         --  OPTION ::=
         --    SIMPLE_OPTION
         --  | NAME_VALUE_OPTION

         --  SIMPLE_OPTION ::= Ghost | Synchronous

         --  NAME_VALUE_OPTION ::=
         --    Part_Of => ABSTRACT_STATE
         --  | External [=> EXTERNAL_PROPERTY_LIST]

         --  EXTERNAL_PROPERTY_LIST ::=
         --     EXTERNAL_PROPERTY
         --  | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY})

         --  EXTERNAL_PROPERTY ::=
         --    Async_Readers    [=> boolean_EXPRESSION]
         --  | Async_Writers    [=> boolean_EXPRESSION]
         --  | Effective_Reads  [=> boolean_EXPRESSION]
         --  | Effective_Writes [=> boolean_EXPRESSION]
         --    others            => boolean_EXPRESSION

         --  STATE_NAME ::= defining_identifier

         --  ABSTRACT_STATE ::= name

         --  Characteristics:

         --    * Analysis - The annotation is fully analyzed immediately upon
         --    elaboration as it cannot forward reference entities.

         --    * Expansion - None.

         --    * Template - The annotation utilizes the generic template of the
         --    related package declaration.

         --    * Globals - The annotation cannot reference global entities.

         --    * Instance - The annotation is instantiated automatically when
         --    the related generic package is instantiated.

         when Pragma_Abstract_State => Abstract_State : declare
            Missing_Parentheses : Boolean := False;
            --  Flag set when a state declaration with options is not properly
            --  parenthesized.

            --  Flags used to verify the consistency of states

            Non_Null_Seen : Boolean := False;
            Null_Seen     : Boolean := False;

            procedure Analyze_Abstract_State
              (State   : Node_Id;
               Pack_Id : Entity_Id);
            --  Verify the legality of a single state declaration. Create and
            --  decorate a state abstraction entity and introduce it into the
            --  visibility chain. Pack_Id denotes the entity or the related
            --  package where pragma Abstract_State appears.

            procedure Malformed_State_Error (State : Node_Id);
            --  Emit an error concerning the illegal declaration of abstract
            --  state State. This routine diagnoses syntax errors that lead to
            --  a different parse tree. The error is issued regardless of the
            --  SPARK mode in effect.

            ----------------------------
            -- Analyze_Abstract_State --
            ----------------------------

            procedure Analyze_Abstract_State
              (State   : Node_Id;
               Pack_Id : Entity_Id)
            is
               --  Flags used to verify the consistency of options

               AR_Seen          : Boolean := False;
               AW_Seen          : Boolean := False;
               ER_Seen          : Boolean := False;
               EW_Seen          : Boolean := False;
               External_Seen    : Boolean := False;
               Ghost_Seen       : Boolean := False;
               Others_Seen      : Boolean := False;
               Part_Of_Seen     : Boolean := False;
               Synchronous_Seen : Boolean := False;

               --  Flags used to store the static value of all external states'
               --  expressions.

               AR_Val : Boolean := False;
               AW_Val : Boolean := False;
               ER_Val : Boolean := False;
               EW_Val : Boolean := False;

               State_Id : Entity_Id := Empty;
               --  The entity to be generated for the current state declaration

               procedure Analyze_External_Option (Opt : Node_Id);
               --  Verify the legality of option External

               procedure Analyze_External_Property
                 (Prop : Node_Id;
                  Expr : Node_Id := Empty);
               --  Verify the legailty of a single external property. Prop
               --  denotes the external property. Expr is the expression used
               --  to set the property.

               procedure Analyze_Part_Of_Option (Opt : Node_Id);
               --  Verify the legality of option Part_Of

               procedure Check_Duplicate_Option
                 (Opt    : Node_Id;
                  Status : in out Boolean);
               --  Flag Status denotes whether a particular option has been
               --  seen while processing a state. This routine verifies that
               --  Opt is not a duplicate option and sets the flag Status
               --  (SPARK RM 7.1.4(1)).

               procedure Check_Duplicate_Property
                 (Prop   : Node_Id;
                  Status : in out Boolean);
               --  Flag Status denotes whether a particular property has been
               --  seen while processing option External. This routine verifies
               --  that Prop is not a duplicate property and sets flag Status.
               --  Opt is not a duplicate property and sets the flag Status.
               --  (SPARK RM 7.1.4(2))

               procedure Check_Ghost_Synchronous;
               --  Ensure that the abstract state is not subject to both Ghost
               --  and Synchronous simple options. Emit an error if this is the
               --  case.

               procedure Create_Abstract_State
                 (Nam     : Name_Id;
                  Decl    : Node_Id;
                  Loc     : Source_Ptr;
                  Is_Null : Boolean);
               --  Generate an abstract state entity with name Nam and enter it
               --  into visibility. Decl is the "declaration" of the state as
               --  it appears in pragma Abstract_State. Loc is the location of
               --  the related state "declaration". Flag Is_Null should be set
               --  when the associated Abstract_State pragma defines a null
               --  state.

               -----------------------------
               -- Analyze_External_Option --
               -----------------------------

               procedure Analyze_External_Option (Opt : Node_Id) is
                  Errors : constant Nat := Serious_Errors_Detected;
                  Prop   : Node_Id;
                  Props  : Node_Id := Empty;

               begin
                  if Nkind (Opt) = N_Component_Association then
                     Props := Expression (Opt);
                  end if;

                  --  External state with properties

                  if Present (Props) then

                     --  Multiple properties appear as an aggregate

                     if Nkind (Props) = N_Aggregate then

                        --  Simple property form

                        Prop := First (Expressions (Props));
                        while Present (Prop) loop
                           Analyze_External_Property (Prop);
                           Next (Prop);
                        end loop;

                        --  Property with expression form

                        Prop := First (Component_Associations (Props));
                        while Present (Prop) loop
                           Analyze_External_Property
                             (Prop => First (Choices (Prop)),
                              Expr => Expression (Prop));

                           Next (Prop);
                        end loop;

                     --  Single property

                     else
                        Analyze_External_Property (Props);
                     end if;

                  --  An external state defined without any properties defaults
                  --  all properties to True.

                  else
                     AR_Val := True;
                     AW_Val := True;
                     ER_Val := True;
                     EW_Val := True;
                  end if;

                  --  Once all external properties have been processed, verify
                  --  their mutual interaction. Do not perform the check when
                  --  at least one of the properties is illegal as this will
                  --  produce a bogus error.

                  if Errors = Serious_Errors_Detected then
                     Check_External_Properties
                       (State, AR_Val, AW_Val, ER_Val, EW_Val);
                  end if;
               end Analyze_External_Option;

               -------------------------------
               -- Analyze_External_Property --
               -------------------------------

               procedure Analyze_External_Property
                 (Prop : Node_Id;
                  Expr : Node_Id := Empty)
               is
                  Expr_Val : Boolean;

               begin
                  --  Check the placement of "others" (if available)

                  if Nkind (Prop) = N_Others_Choice then
                     if Others_Seen then
                        SPARK_Msg_N
                          ("only one others choice allowed in option External",
                           Prop);
                     else
                        Others_Seen := True;
                     end if;

                  elsif Others_Seen then
                     SPARK_Msg_N
                       ("others must be the last property in option External",
                        Prop);

                  --  The only remaining legal options are the four predefined
                  --  external properties.

                  elsif Nkind (Prop) = N_Identifier
                    and then Nam_In (Chars (Prop), Name_Async_Readers,
                                                   Name_Async_Writers,
                                                   Name_Effective_Reads,
                                                   Name_Effective_Writes)
                  then
                     null;

                  --  Otherwise the construct is not a valid property

                  else
                     SPARK_Msg_N ("invalid external state property", Prop);
                     return;
                  end if;

                  --  Ensure that the expression of the external state property
                  --  is static Boolean (if applicable) (SPARK RM 7.1.2(5)).

                  if Present (Expr) then
                     Analyze_And_Resolve (Expr, Standard_Boolean);

                     if Is_OK_Static_Expression (Expr) then
                        Expr_Val := Is_True (Expr_Value (Expr));
                     else
                        SPARK_Msg_N
                          ("expression of external state property must be "
                           & "static", Expr);
                        return;
                     end if;

                  --  The lack of expression defaults the property to True

                  else
                     Expr_Val := True;
                  end if;

                  --  Named properties

                  if Nkind (Prop) = N_Identifier then
                     if Chars (Prop) = Name_Async_Readers then
                        Check_Duplicate_Property (Prop, AR_Seen);
                        AR_Val := Expr_Val;

                     elsif Chars (Prop) = Name_Async_Writers then
                        Check_Duplicate_Property (Prop, AW_Seen);
                        AW_Val := Expr_Val;

                     elsif Chars (Prop) = Name_Effective_Reads then
                        Check_Duplicate_Property (Prop, ER_Seen);
                        ER_Val := Expr_Val;

                     else
                        Check_Duplicate_Property (Prop, EW_Seen);
                        EW_Val := Expr_Val;
                     end if;

                  --  The handling of property "others" must take into account
                  --  all other named properties that have been encountered so
                  --  far. Only those that have not been seen are affected by
                  --  "others".

                  else
                     if not AR_Seen then
                        AR_Val := Expr_Val;
                     end if;

                     if not AW_Seen then
                        AW_Val := Expr_Val;
                     end if;

                     if not ER_Seen then
                        ER_Val := Expr_Val;
                     end if;

                     if not EW_Seen then
                        EW_Val := Expr_Val;
                     end if;
                  end if;
               end Analyze_External_Property;

               ----------------------------
               -- Analyze_Part_Of_Option --
               ----------------------------

               procedure Analyze_Part_Of_Option (Opt : Node_Id) is
                  Encap    : constant Node_Id := Expression (Opt);
                  Constits : Elist_Id;
                  Encap_Id : Entity_Id;
                  Legal    : Boolean;

               begin
                  Check_Duplicate_Option (Opt, Part_Of_Seen);

                  Analyze_Part_Of
                    (Indic    => First (Choices (Opt)),
                     Item_Id  => State_Id,
                     Encap    => Encap,
                     Encap_Id => Encap_Id,
                     Legal    => Legal);

                  --  The Part_Of indicator transforms the abstract state into
                  --  a constituent of the encapsulating state or single
                  --  concurrent type.

                  if Legal then
                     pragma Assert (Present (Encap_Id));
                     Constits := Part_Of_Constituents (Encap_Id);

                     if No (Constits) then
                        Constits := New_Elmt_List;
                        Set_Part_Of_Constituents (Encap_Id, Constits);
                     end if;

                     Append_Elmt (State_Id, Constits);
                     Set_Encapsulating_State (State_Id, Encap_Id);
                  end if;
               end Analyze_Part_Of_Option;

               ----------------------------
               -- Check_Duplicate_Option --
               ----------------------------

               procedure Check_Duplicate_Option
                 (Opt    : Node_Id;
                  Status : in out Boolean)
               is
               begin
                  if Status then
                     SPARK_Msg_N ("duplicate state option", Opt);
                  end if;

                  Status := True;
               end Check_Duplicate_Option;

               ------------------------------
               -- Check_Duplicate_Property --
               ------------------------------

               procedure Check_Duplicate_Property
                 (Prop   : Node_Id;
                  Status : in out Boolean)
               is
               begin
                  if Status then
                     SPARK_Msg_N ("duplicate external property", Prop);
                  end if;

                  Status := True;
               end Check_Duplicate_Property;

               -----------------------------
               -- Check_Ghost_Synchronous --
               -----------------------------

               procedure Check_Ghost_Synchronous is
               begin
                  --  A synchronized abstract state cannot be Ghost and vice
                  --  versa (SPARK RM 6.9(19)).

                  if Ghost_Seen and Synchronous_Seen then
                     SPARK_Msg_N ("synchronized state cannot be ghost", State);
                  end if;
               end Check_Ghost_Synchronous;

               ---------------------------
               -- Create_Abstract_State --
               ---------------------------

               procedure Create_Abstract_State
                 (Nam     : Name_Id;
                  Decl    : Node_Id;
                  Loc     : Source_Ptr;
                  Is_Null : Boolean)
               is
               begin
                  --  The abstract state may be semi-declared when the related
                  --  package was withed through a limited with clause. In that
                  --  case reuse the entity to fully declare the state.

                  if Present (Decl) and then Present (Entity (Decl)) then
                     State_Id := Entity (Decl);

                  --  Otherwise the elaboration of pragma Abstract_State
                  --  declares the state.

                  else
                     State_Id := Make_Defining_Identifier (Loc, Nam);

                     if Present (Decl) then
                        Set_Entity (Decl, State_Id);
                     end if;
                  end if;

                  --  Null states never come from source

                  Set_Comes_From_Source   (State_Id, not Is_Null);
                  Set_Parent              (State_Id, State);
                  Set_Ekind               (State_Id, E_Abstract_State);
                  Set_Etype               (State_Id, Standard_Void_Type);
                  Set_Encapsulating_State (State_Id, Empty);

                  --  Set the SPARK mode from the current context

                  Set_SPARK_Pragma           (State_Id, SPARK_Mode_Pragma);
                  Set_SPARK_Pragma_Inherited (State_Id);

                  --  An abstract state declared within a Ghost region becomes
                  --  Ghost (SPARK RM 6.9(2)).

                  if Ghost_Mode > None or else Is_Ghost_Entity (Pack_Id) then
                     Set_Is_Ghost_Entity (State_Id);
                  end if;

                  --  Establish a link between the state declaration and the
                  --  abstract state entity. Note that a null state remains as
                  --  N_Null and does not carry any linkages.

                  if not Is_Null then
                     if Present (Decl) then
                        Set_Entity (Decl, State_Id);
                        Set_Etype  (Decl, Standard_Void_Type);
                     end if;

                     --  Every non-null state must be defined, nameable and
                     --  resolvable.

                     Push_Scope (Pack_Id);
                     Generate_Definition (State_Id);
                     Enter_Name (State_Id);
                     Pop_Scope;
                  end if;
               end Create_Abstract_State;

               --  Local variables

               Opt     : Node_Id;
               Opt_Nam : Node_Id;

            --  Start of processing for Analyze_Abstract_State

            begin
               --  A package with a null abstract state is not allowed to
               --  declare additional states.

               if Null_Seen then
                  SPARK_Msg_NE
                    ("package & has null abstract state", State, Pack_Id);

               --  Null states appear as internally generated entities

               elsif Nkind (State) = N_Null then
                  Create_Abstract_State
                    (Nam     => New_Internal_Name ('S'),
                     Decl    => Empty,
                     Loc     => Sloc (State),
                     Is_Null => True);
                  Null_Seen := True;

                  --  Catch a case where a null state appears in a list of
                  --  non-null states.

                  if Non_Null_Seen then
                     SPARK_Msg_NE
                       ("package & has non-null abstract state",
                        State, Pack_Id);
                  end if;

               --  Simple state declaration

               elsif Nkind (State) = N_Identifier then
                  Create_Abstract_State
                    (Nam     => Chars (State),
                     Decl    => State,
                     Loc     => Sloc (State),
                     Is_Null => False);
                  Non_Null_Seen := True;

               --  State declaration with various options. This construct
               --  appears as an extension aggregate in the tree.

               elsif Nkind (State) = N_Extension_Aggregate then
                  if Nkind (Ancestor_Part (State)) = N_Identifier then
                     Create_Abstract_State
                       (Nam     => Chars (Ancestor_Part (State)),
                        Decl    => Ancestor_Part (State),
                        Loc     => Sloc (Ancestor_Part (State)),
                        Is_Null => False);
                     Non_Null_Seen := True;
                  else
                     SPARK_Msg_N
                       ("state name must be an identifier",
                        Ancestor_Part (State));
                  end if;

                  --  Options External, Ghost and Synchronous appear as
                  --  expressions.

                  Opt := First (Expressions (State));
                  while Present (Opt) loop
                     if Nkind (Opt) = N_Identifier then

                        --  External

                        if Chars (Opt) = Name_External then
                           Check_Duplicate_Option (Opt, External_Seen);
                           Analyze_External_Option (Opt);

                        --  Ghost

                        elsif Chars (Opt) = Name_Ghost then
                           Check_Duplicate_Option (Opt, Ghost_Seen);
                           Check_Ghost_Synchronous;

                           if Present (State_Id) then
                              Set_Is_Ghost_Entity (State_Id);
                           end if;

                        --  Synchronous

                        elsif Chars (Opt) = Name_Synchronous then
                           Check_Duplicate_Option (Opt, Synchronous_Seen);
                           Check_Ghost_Synchronous;

                        --  Option Part_Of without an encapsulating state is
                        --  illegal (SPARK RM 7.1.4(9)).

                        elsif Chars (Opt) = Name_Part_Of then
                           SPARK_Msg_N
                             ("indicator Part_Of must denote abstract state, "
                              & "single protected type or single task type",
                              Opt);

                        --  Do not emit an error message when a previous state
                        --  declaration with options was not parenthesized as
                        --  the option is actually another state declaration.
                        --
                        --    with Abstract_State
                        --      (State_1 with ...,   --  missing parentheses
                        --      (State_2 with ...),
                        --       State_3)            --  ok state declaration

                        elsif Missing_Parentheses then
                           null;

                        --  Otherwise the option is not allowed. Note that it
                        --  is not possible to distinguish between an option
                        --  and a state declaration when a previous state with
                        --  options not properly parentheses.
                        --
                        --    with Abstract_State
                        --      (State_1 with ...,  --  missing parentheses
                        --       State_2);          --  could be an option

                        else
                           SPARK_Msg_N
                             ("simple option not allowed in state declaration",
                              Opt);
                        end if;

                     --  Catch a case where missing parentheses around a state
                     --  declaration with options cause a subsequent state
                     --  declaration with options to be treated as an option.
                     --
                     --    with Abstract_State
                     --      (State_1 with ...,   --  missing parentheses
                     --      (State_2 with ...))

                     elsif Nkind (Opt) = N_Extension_Aggregate then
                        Missing_Parentheses := True;
                        SPARK_Msg_N
                          ("state declaration must be parenthesized",
                           Ancestor_Part (State));

                     --  Otherwise the option is malformed

                     else
                        SPARK_Msg_N ("malformed option", Opt);
                     end if;

                     Next (Opt);
                  end loop;

                  --  Options External and Part_Of appear as component
                  --  associations.

                  Opt := First (Component_Associations (State));
                  while Present (Opt) loop
                     Opt_Nam := First (Choices (Opt));

                     if Nkind (Opt_Nam) = N_Identifier then
                        if Chars (Opt_Nam) = Name_External then
                           Analyze_External_Option (Opt);

                        elsif Chars (Opt_Nam) = Name_Part_Of then
                           Analyze_Part_Of_Option (Opt);

                        else
                           SPARK_Msg_N ("invalid state option", Opt);
                        end if;
                     else
                        SPARK_Msg_N ("invalid state option", Opt);
                     end if;

                     Next (Opt);
                  end loop;

               --  Any other attempt to declare a state is illegal

               else
                  Malformed_State_Error (State);
                  return;
               end if;

               --  Guard against a junk state. In such cases no entity is
               --  generated and the subsequent checks cannot be applied.

               if Present (State_Id) then

                  --  Verify whether the state does not introduce an illegal
                  --  hidden state within a package subject to a null abstract
                  --  state.

                  Check_No_Hidden_State (State_Id);

                  --  Check whether the lack of option Part_Of agrees with the
                  --  placement of the abstract state with respect to the state
                  --  space.

                  if not Part_Of_Seen then
                     Check_Missing_Part_Of (State_Id);
                  end if;

                  --  Associate the state with its related package

                  if No (Abstract_States (Pack_Id)) then
                     Set_Abstract_States (Pack_Id, New_Elmt_List);
                  end if;

                  Append_Elmt (State_Id, Abstract_States (Pack_Id));
               end if;
            end Analyze_Abstract_State;

            ---------------------------
            -- Malformed_State_Error --
            ---------------------------

            procedure Malformed_State_Error (State : Node_Id) is
            begin
               Error_Msg_N ("malformed abstract state declaration", State);

               --  An abstract state with a simple option is being declared
               --  with "=>" rather than the legal "with". The state appears
               --  as a component association.

               if Nkind (State) = N_Component_Association then
                  Error_Msg_N ("\use WITH to specify simple option", State);
               end if;
            end Malformed_State_Error;

            --  Local variables

            Pack_Decl : Node_Id;
            Pack_Id   : Entity_Id;
            State     : Node_Id;
            States    : Node_Id;

         --  Start of processing for Abstract_State

         begin
            GNAT_Pragma;
            Check_No_Identifiers;
            Check_Arg_Count (1);

            Pack_Decl := Find_Related_Package_Or_Body (N, Do_Checks => True);

            if not Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
                                        N_Package_Declaration)
            then
               Pragma_Misplaced;
               return;
            end if;

            Pack_Id := Defining_Entity (Pack_Decl);

            --  A pragma that applies to a Ghost entity becomes Ghost for the
            --  purposes of legality checks and removal of ignored Ghost code.

            Mark_Ghost_Pragma (N, Pack_Id);
            Ensure_Aggregate_Form (Get_Argument (N, Pack_Id));

            --  Chain the pragma on the contract for completeness

            Add_Contract_Item (N, Pack_Id);

            --  The legality checks of pragmas Abstract_State, Initializes, and
            --  Initial_Condition are affected by the SPARK mode in effect. In
            --  addition, these three pragmas are subject to an inherent order:

            --    1) Abstract_State
            --    2) Initializes
            --    3) Initial_Condition

            --  Analyze all these pragmas in the order outlined above

            Analyze_If_Present (Pragma_SPARK_Mode);
            States := Expression (Get_Argument (N, Pack_Id));

            --  Multiple non-null abstract states appear as an aggregate

            if Nkind (States) = N_Aggregate then
               State := First (Expressions (States));
               while Present (State) loop
                  Analyze_Abstract_State (State, Pack_Id);
                  Next (State);
               end loop;

               --  An abstract state with a simple option is being illegaly
               --  declared with "=>" rather than "with". In this case the
               --  state declaration appears as a component association.

               if Present (Component_Associations (States)) then
                  State := First (Component_Associations (States));
                  while Present (State) loop
                     Malformed_State_Error (State);
                     Next (State);
                  end loop;
               end if;

            --  Various forms of a single abstract state. Note that these may
            --  include malformed state declarations.

            else
               Analyze_Abstract_State (States, Pack_Id);
            end if;

            Analyze_If_Present (Pragma_Initializes);
            Analyze_If_Present (Pragma_Initial_Condition);
         end Abstract_State;

         --------------
         -- Acc_Data --
         --------------

         when Pragma_Acc_Data => Acc_Data : declare
            Clause_Names : constant Name_List :=
              (Name_Attach,
               Name_Copy,
               Name_Copy_In,
               Name_Copy_Out,
               Name_Create,
               Name_Delete,
               Name_Detach,
               Name_Device_Ptr,
               Name_No_Create,
               Name_Present);

            Clause  : Node_Id;
            Clauses : Args_List (Clause_Names'Range);

         begin
            if not OpenAcc_Enabled then
               return;
            end if;

            GNAT_Pragma;

            if Nkind (Parent (N)) /= N_Loop_Statement then
               Error_Pragma
                 ("Acc_Data pragma should be placed in loop or block "
                  & "statements");
            end if;

            Gather_Associations (Clause_Names, Clauses);

            for Id in Clause_Names'First .. Clause_Names'Last loop
               Clause := Clauses (Id);

               if Present (Clause) then
                  case Clause_Names (Id) is
                     when Name_Copy
                        | Name_Copy_In
                        | Name_Copy_Out
                        | Name_Create
                        | Name_Device_Ptr
                        | Name_Present
                     =>
                        Validate_Acc_Data_Clause (Clause);

                     when Name_Attach
                        | Name_Detach
                        | Name_Delete
                        | Name_No_Create
                      =>
                        Error_Pragma ("unsupported pragma clause");

                     when others =>
                        raise Program_Error;
                  end case;
               end if;
            end loop;

            Set_Is_OpenAcc_Environment (Parent (N));
         end Acc_Data;

         --------------
         -- Acc_Loop --
         --------------

         when Pragma_Acc_Loop => Acc_Loop : declare
            Clause_Names : constant Name_List :=
              (Name_Auto,
               Name_Collapse,
               Name_Gang,
               Name_Independent,
               Name_Acc_Private,
               Name_Reduction,
               Name_Seq,
               Name_Tile,
               Name_Vector,
               Name_Worker);

            Clause  : Node_Id;
            Clauses : Args_List (Clause_Names'Range);
            Par     : Node_Id;

         begin
            if not OpenAcc_Enabled then
               return;
            end if;

            GNAT_Pragma;

            --  Make sure the pragma is in an openacc construct

            Check_Loop_Pragma_Placement;

            Par := Parent (N);
            while Present (Par)
              and then (Nkind (Par) /= N_Loop_Statement
                         or else not Is_OpenAcc_Environment (Par))
            loop
               Par := Parent (Par);
            end loop;

            if not Is_OpenAcc_Environment (Par) then
               Error_Pragma
                 ("Acc_Loop directive must be associated with an OpenAcc "
                  & "construct region");
            end if;

            Gather_Associations (Clause_Names, Clauses);

            for Id in Clause_Names'First .. Clause_Names'Last loop
               Clause := Clauses (Id);

               if Present (Clause) then
                  case Clause_Names (Id) is
                     when Name_Auto
                        | Name_Independent
                        | Name_Seq
                     =>
                        null;

                     when Name_Collapse =>
                        Validate_Acc_Loop_Collapse (Clause);

                     when Name_Gang =>
                        Validate_Acc_Loop_Gang (Clause);

                     when Name_Acc_Private =>
                        Validate_Acc_Data_Clause (Clause);

                     when Name_Reduction =>
                        Validate_Acc_Name_Reduction (Clause);

                     when Name_Tile =>
                        Validate_Acc_Size_Expressions (Clause);

                     when Name_Vector =>
                        Validate_Acc_Loop_Vector (Clause);

                     when Name_Worker =>
                        Validate_Acc_Loop_Worker (Clause);

                     when others =>
                        raise Program_Error;
                  end case;
               end if;
            end loop;

            Set_Is_OpenAcc_Loop (Parent (N));
         end Acc_Loop;

         ----------------------------------
         -- Acc_Parallel and Acc_Kernels --
         ----------------------------------

         when Pragma_Acc_Parallel
            | Pragma_Acc_Kernels
         =>
         Acc_Kernels_Or_Parallel : declare
            Clause_Names : constant Name_List :=
              (Name_Acc_If,
               Name_Async,
               Name_Copy,
               Name_Copy_In,
               Name_Copy_Out,
               Name_Create,
               Name_Default,
               Name_Device_Ptr,
               Name_Device_Type,
               Name_Num_Gangs,
               Name_Num_Workers,
               Name_Present,
               Name_Vector_Length,
               Name_Wait,

               --  Parallel only

               Name_Acc_Private,
               Name_First_Private,
               Name_Reduction,

               --  Kernels only

               Name_Attach,
               Name_No_Create);

            Clause  : Node_Id;
            Clauses : Args_List (Clause_Names'Range);

         begin
            if not OpenAcc_Enabled then
               return;
            end if;

            GNAT_Pragma;
            Check_Loop_Pragma_Placement;

            if Nkind (Parent (N)) /= N_Loop_Statement then
               Error_Pragma
                 ("pragma should be placed in loop or block statements");
            end if;

            Gather_Associations (Clause_Names, Clauses);

            for Id in Clause_Names'First .. Clause_Names'Last loop
               Clause := Clauses (Id);

               if Present (Clause) then
                  if Chars (Parent (Clause)) = No_Name then
                     Error_Pragma ("all arguments should be associations");
                  else
                     case Clause_Names (Id) is

                        --  Note: According to the OpenAcc Standard v2.6,
                        --  Async's argument should be optional. Because this
                        --  complicates parsing the clause, the argument is
                        --  made mandatory. The standard defines two negative
                        --  values, acc_async_noval and acc_async_sync. When
                        --  given acc_async_noval as value, the clause should
                        --  behave as if no argument was given. According to
                        --  the standard, acc_async_noval is defined in header