[multiple changes]

2012-10-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb, s-tarest.ads, exp_ch3.adb: Update comments.

2012-10-29  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Minor documentation addition.

2012-10-29  Emmanuel Briot  <briot@adacore.com>

	* xr_tabls.adb, xr_tabls.ads (Add_Declaration, Add_Reference): No
	longer assume that a parameter declaration is seen after the subprogram
	that uses it.

2012-10-29  Tristan Gingold  <gingold@adacore.com>

	* lib-writ.adb (Write_ALI): Emit partition elaboration policy
	in P line.
	* lib-writ.ads: Document partition elaboration policy indication.
	* sem_prag.adb (Check_Arg_Is_Partition_Elaboration_Policy): New
	procedure.
	(Analyze_Pragma): Handle Partition_Elaboration_Policy.
	(Sig_Flags): Add flag for Pragma_Partition_Elaboration_Policy
	* ali.adb (Initialize_ALI): Init Partition_Elaboration_Policy_Specified.
	(Scan_ALI): Read Ex indications.
	* ali.ads: ALIs_Record: Add Partition_Elaboration_Policy.
	* par-prag.adb (Prag): Add Partition_Elaboration_Policy.
	* snames.adb-tmpl (Is_Partition_Elaboration_Policy_Name): New function.
	* opt.ads (Partition_Elaboration_Policy): Declare.
	(Partition_Elaboration_Policy_Sloc): Declare.
	* bcheck.adb (Check_Consistent_Partition_Elaboration_Policy):
	New procedure.	(Check_Configuration_Consistency): Check partition
	elaboration policy consistency.
	* snames.ads-tmpl (Name_Partition_Elaboration_Policy): New name.
	(First_Partition_Elaboration_Policy_Name, Name_Concurrent,
	Name_Sequential, Last_Partition_Elaboration_Policy_Name): Likewise.
	(Pragma_Partition_Elaboration_Policy): New literal.
	(Is_Partition_Elaboration_Policy_Name): New function.

2012-10-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Is_Public_Subprogram_For): Handle properly
	expression functions, which are rewritten as subprogram
	declarations, when generating invariants for its return value
	and in-out parameters.

From-SVN: r192928

18 files changed, 357 insertions, 85 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 76b143d..f6550b6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,49 @@
+2012-10-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch9.adb, s-tarest.ads, exp_ch3.adb: Update comments.
+
+2012-10-29  Yannick Moy  <moy@adacore.com>
+
+	* gnat_rm.texi: Minor documentation addition.
+
+2012-10-29  Emmanuel Briot  <briot@adacore.com>
+
+	* xr_tabls.adb, xr_tabls.ads (Add_Declaration, Add_Reference): No
+	longer assume that a parameter declaration is seen after the subprogram
+	that uses it.
+
+2012-10-29  Tristan Gingold  <gingold@adacore.com>
+
+	* lib-writ.adb (Write_ALI): Emit partition elaboration policy
+	in P line.
+	* lib-writ.ads: Document partition elaboration policy indication.
+	* sem_prag.adb (Check_Arg_Is_Partition_Elaboration_Policy): New
+	procedure.
+	(Analyze_Pragma): Handle Partition_Elaboration_Policy.
+	(Sig_Flags): Add flag for Pragma_Partition_Elaboration_Policy
+	* ali.adb (Initialize_ALI): Init Partition_Elaboration_Policy_Specified.
+	(Scan_ALI): Read Ex indications.
+	* ali.ads: ALIs_Record: Add Partition_Elaboration_Policy.
+	* par-prag.adb (Prag): Add Partition_Elaboration_Policy.
+	* snames.adb-tmpl (Is_Partition_Elaboration_Policy_Name): New function.
+	* opt.ads (Partition_Elaboration_Policy): Declare.
+	(Partition_Elaboration_Policy_Sloc): Declare.
+	* bcheck.adb (Check_Consistent_Partition_Elaboration_Policy):
+	New procedure.	(Check_Configuration_Consistency): Check partition
+	elaboration policy consistency.
+	* snames.ads-tmpl (Name_Partition_Elaboration_Policy): New name.
+	(First_Partition_Elaboration_Policy_Name, Name_Concurrent,
+	Name_Sequential, Last_Partition_Elaboration_Policy_Name): Likewise.
+	(Pragma_Partition_Elaboration_Policy): New literal.
+	(Is_Partition_Elaboration_Policy_Name): New function.
+
+2012-10-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Is_Public_Subprogram_For): Handle properly
+	expression functions, which are rewritten as subprogram
+	declarations, when generating invariants for its return value
+	and in-out parameters.
+
 2012-10-29  Arnaud Charlet  <charlet@adacore.com>
 
 	* warnsw.adb (Set_GNAT_Mode_Warnings): Unset
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 86ad184..a85fa4b 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -107,17 +107,18 @@ package body ALI is
       --  Initialize global variables recording cumulative options in all
       --  ALI files that are read for a given processing run in gnatbind.
 
-      Dynamic_Elaboration_Checks_Specified := False;
-      Float_Format_Specified               := ' ';
-      Locking_Policy_Specified             := ' ';
-      No_Normalize_Scalars_Specified       := False;
-      No_Object_Specified                  := False;
-      Normalize_Scalars_Specified          := False;
-      Queuing_Policy_Specified             := ' ';
-      Static_Elaboration_Model_Used        := False;
-      Task_Dispatching_Policy_Specified    := ' ';
-      Unreserve_All_Interrupts_Specified   := False;
-      Zero_Cost_Exceptions_Specified       := False;
+      Dynamic_Elaboration_Checks_Specified   := False;
+      Float_Format_Specified                 := ' ';
+      Locking_Policy_Specified               := ' ';
+      No_Normalize_Scalars_Specified         := False;
+      No_Object_Specified                    := False;
+      Normalize_Scalars_Specified            := False;
+      Partition_Elaboration_Policy_Specified := ' ';
+      Queuing_Policy_Specified               := ' ';
+      Static_Elaboration_Model_Used          := False;
+      Task_Dispatching_Policy_Specified      := ' ';
+      Unreserve_All_Interrupts_Specified     := False;
+      Zero_Cost_Exceptions_Specified         := False;
    end Initialize_ALI;
 
    --------------
@@ -813,36 +814,37 @@ package body ALI is
       Set_Name_Table_Info (F, Int (Id));
 
       ALIs.Table (Id) := (
-        Afile                      => F,
-        Compile_Errors             => False,
-        First_Interrupt_State      => Interrupt_States.Last + 1,
-        First_Sdep                 => No_Sdep_Id,
-        First_Specific_Dispatching => Specific_Dispatching.Last + 1,
-        First_Unit                 => No_Unit_Id,
-        Float_Format               => 'I',
-        Last_Interrupt_State       => Interrupt_States.Last,
-        Last_Sdep                  => No_Sdep_Id,
-        Last_Specific_Dispatching  => Specific_Dispatching.Last,
-        Last_Unit                  => No_Unit_Id,
-        Locking_Policy             => ' ',
-        Main_Priority              => -1,
-        Main_CPU                   => -1,
-        Main_Program               => None,
-        No_Object                  => False,
-        Normalize_Scalars          => False,
-        Ofile_Full_Name            => Full_Object_File_Name,
-        Queuing_Policy             => ' ',
-        Restrictions               => No_Restrictions,
-        SAL_Interface              => False,
-        Sfile                      => No_File,
-        Task_Dispatching_Policy    => ' ',
-        Time_Slice_Value           => -1,
-        Allocator_In_Body          => False,
-        WC_Encoding                => 'b',
-        Unit_Exception_Table       => False,
-        Ver                        => (others => ' '),
-        Ver_Len                    => 0,
-        Zero_Cost_Exceptions       => False);
+        Afile                        => F,
+        Compile_Errors               => False,
+        First_Interrupt_State        => Interrupt_States.Last + 1,
+        First_Sdep                   => No_Sdep_Id,
+        First_Specific_Dispatching   => Specific_Dispatching.Last + 1,
+        First_Unit                   => No_Unit_Id,
+        Float_Format                 => 'I',
+        Last_Interrupt_State         => Interrupt_States.Last,
+        Last_Sdep                    => No_Sdep_Id,
+        Last_Specific_Dispatching    => Specific_Dispatching.Last,
+        Last_Unit                    => No_Unit_Id,
+        Locking_Policy               => ' ',
+        Main_Priority                => -1,
+        Main_CPU                     => -1,
+        Main_Program                 => None,
+        No_Object                    => False,
+        Normalize_Scalars            => False,
+        Ofile_Full_Name              => Full_Object_File_Name,
+        Partition_Elaboration_Policy => ' ',
+        Queuing_Policy               => ' ',
+        Restrictions                 => No_Restrictions,
+        SAL_Interface                => False,
+        Sfile                        => No_File,
+        Task_Dispatching_Policy      => ' ',
+        Time_Slice_Value             => -1,
+        Allocator_In_Body            => False,
+        WC_Encoding                  => 'b',
+        Unit_Exception_Table         => False,
+        Ver                          => (others => ' '),
+        Ver_Len                      => 0,
+        Zero_Cost_Exceptions         => False);
 
       --  Now we acquire the input lines from the ALI file. Note that the
       --  convention in the following code is that as we enter each section,
@@ -1027,6 +1029,13 @@ package body ALI is
                Checkc ('B');
                Detect_Blocking := True;
 
+            --  Processing for Ex
+
+            elsif C = 'E' then
+               Partition_Elaboration_Policy_Specified := Getc;
+               ALIs.Table (Id).Partition_Elaboration_Policy :=
+                 Partition_Elaboration_Policy_Specified;
+
             --  Processing for FD/FG/FI
 
             elsif C = 'F' then
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index 39943c4..2c800e7 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -156,6 +156,12 @@ package ALI is
       --  this is a language defined unit. Otherwise set to first character
       --  (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
 
+      Partition_Elaboration_Policy : Character;
+      --  Indicates partition elaboration policy for units in this file. Space
+      --  means that no Partition_Elaboration_Policy pragma was present or that
+      --  this is a language defined unit. Otherwise set to first character
+      --  (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
+
       Queuing_Policy : Character;
       --  Indicates queuing policy for units in this file. Space means tasking
       --  was not used, or that no Queuing_Policy pragma was present or that
@@ -485,6 +491,11 @@ package ALI is
    --  Set to False by Initialize_ALI. Set to True if an ali file indicates
    --  that the file was compiled in Normalize_Scalars mode.
 
+   Partition_Elaboration_Policy_Specified : Character := ' ';
+   --  Set to blank by Initialize_ALI. Set to the appropriate partition
+   --  elaboration policy character if an ali file contains a P line setting
+   --  the policy.
+
    Queuing_Policy_Specified : Character := ' ';
    --  Set to blank by Initialize_ALI. Set to the appropriate queuing policy
    --  character if an ali file contains a P line setting the queuing policy.
diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb
index 2efe6da..09354ec 100644
--- a/gcc/ada/bcheck.adb
+++ b/gcc/ada/bcheck.adb
@@ -52,6 +52,7 @@ package body Bcheck is
    procedure Check_Consistent_Locking_Policy;
    procedure Check_Consistent_Normalize_Scalars;
    procedure Check_Consistent_Optimize_Alignment;
+   procedure Check_Consistent_Partition_Elaboration_Policy;
    procedure Check_Consistent_Queuing_Policy;
    procedure Check_Consistent_Restrictions;
    procedure Check_Consistent_Restriction_No_Default_Initialization;
@@ -83,6 +84,10 @@ package body Bcheck is
          Check_Consistent_Locking_Policy;
       end if;
 
+      if Partition_Elaboration_Policy_Specified /= ' ' then
+         Check_Consistent_Partition_Elaboration_Policy;
+      end if;
+
       if Zero_Cost_Exceptions_Specified then
          Check_Consistent_Zero_Cost_Exception_Handling;
       end if;
@@ -744,6 +749,59 @@ package body Bcheck is
       end loop;
    end Check_Consistent_Optimize_Alignment;
 
+   ---------------------------------------------------
+   -- Check_Consistent_Partition_Elaboration_Policy --
+   ---------------------------------------------------
+
+   --  The rule is that all files for which the partition elaboration policy is
+   --  significant must be compiled with the same setting.
+
+   procedure Check_Consistent_Partition_Elaboration_Policy is
+   begin
+      --  First search for a unit specifying a policy and then
+      --  check all remaining units against it.
+
+      Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
+         if ALIs.Table (A1).Partition_Elaboration_Policy /= ' ' then
+            Check_Policy : declare
+               Policy : constant Character :=
+                  ALIs.Table (A1).Partition_Elaboration_Policy;
+
+            begin
+               for A2 in A1 + 1 .. ALIs.Last loop
+                  if ALIs.Table (A2).Partition_Elaboration_Policy /= ' '
+                       and then
+                     ALIs.Table (A2).Partition_Elaboration_Policy /= Policy
+                  then
+                     Error_Msg_File_1 := ALIs.Table (A1).Sfile;
+                     Error_Msg_File_2 := ALIs.Table (A2).Sfile;
+
+                     Consistency_Error_Msg
+                       ("{ and { compiled with different partition "
+                          & "elaboration policies");
+                     exit Find_Policy;
+                  end if;
+               end loop;
+            end Check_Policy;
+
+            --  A No_Task_Hierarchy restriction must be specified for the
+            --  Sequential policy (RM H.6(6/2)).
+
+            if Partition_Elaboration_Policy_Specified = 'S'
+              and then not Cumulative_Restrictions.Set (No_Task_Hierarchy)
+            then
+               Error_Msg_File_1 := ALIs.Table (A1).Sfile;
+               Error_Msg
+                 ("{ has sequential partition elaboration policy, but no");
+               Error_Msg
+                 ("pragma Restrictions (No_Task_Hierarchy) was specified");
+            end if;
+
+            exit Find_Policy;
+         end if;
+      end loop Find_Policy;
+   end Check_Consistent_Partition_Elaboration_Policy;
+
    -------------------------------------
    -- Check_Consistent_Queuing_Policy --
    -------------------------------------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 5df52c1..83ae4e4 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1537,7 +1537,8 @@ package body Exp_Ch3 is
             Append_To (Args, Make_Identifier (Loc, Name_uMaster));
          end if;
 
-         --  Add _Chain (not done in the restricted profile because ???)
+         --  Add _Chain (not done in the restricted profile because not used,
+         --  see comment of Create_Restricted_Task in s-tarest.ads).
 
          if not Restricted_Profile then
             Append_To (Args, Make_Identifier (Loc, Name_uChain));
@@ -1993,7 +1994,8 @@ package body Exp_Ch3 is
 
             if not Restricted_Profile then
 
-               --  No _Chain for restricted profile
+               --  No _Chain for the restricted profile because not used,
+               --  see comment of Create_Restricted_Task in s-tarest.ads.
 
                Append_To (Args, Make_Identifier (Loc, Name_uChain));
             end if;
@@ -7806,7 +7808,8 @@ package body Exp_Ch3 is
 
          if not Restricted_Profile then
 
-            --  No _Chain for restricted profile
+            --  No _Chain for the restricted profile because not used, see
+            --  comment of Create_Restricted_Task in s-tarest.ads.
 
             Append_To (Formals,
               Make_Parameter_Specification (Loc,
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 94a71ff..f103e92 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -911,7 +911,8 @@ package body Exp_Ch9 is
    --  Start of processing for Build_Activation_Chain_Entity
 
    begin
-      --  Activation chain is never used in restricted profile (why not???)
+      --  Activation chain is never used in restricted profile, see comment
+      --  of Create_Restricted_Task in s-tarest.ads.
 
       if Restricted_Profile then
          return;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 7e0df9f..3561ced 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1212,7 +1212,24 @@ pragma Assert_And_Cut (
 The effect of this pragma for compilation is exactly the same as the one
 of pragma @code{Assert}. This pragma is used to help formal verification
 tools by marking program points where the tool can simplify precise
-knowledge about execution based on the assertion given.
+knowledge about execution based on the assertion given. For example, in
+the procedure below, all that is needed to prove that the code using X
+is free from run-time errors is that X is positive. Without the pragma,
+GNATprove considers all execution paths through P, which may be
+many. With the pragma, GNATprove only needs to consider the paths from
+the start of the procedure to the pragma, and the paths from the pragma
+to the end of the procedure, hence many fewer paths. For more details,
+see the GNATprove User's Guide.
+
+@smallexample @c ada
+procedure P is
+   X : Integer;
+begin
+   --  complex computation that sets X
+   pragma Assert_And_Cut (X > 0);
+   --  complex computation that uses X
+end P;
+@end smallexample
 
 @node Pragma Assertion_Policy
 @unnumberedsec Pragma Assertion_Policy
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 1c55a06..e84023c 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -1099,6 +1099,11 @@ package body Lib.Writ is
          end if;
       end if;
 
+      if Partition_Elaboration_Policy /= ' ' then
+         Write_Info_Str  (" E");
+         Write_Info_Char (Partition_Elaboration_Policy);
+      end if;
+
       if not Object then
          Write_Info_Str (" NO");
       end if;
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index fdc9948..72f10d9 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -196,6 +196,10 @@ package Lib.Writ is
    --         DB   Detect_Blocking pragma is in effect for all units in this
    --              file.
    --
+   --         Ex   A valid Partition_Elaboration_Policy pragma applies to all
+   --              the units in this file, where x is the first character
+   --              (upper case) of the policy name (e.g. 'C' for Concurrent).
+   --
    --         FD   Configuration pragmas apply to all the units in this file
    --              specifying a possibly non-standard floating point format
    --              (VAX float with Long_Float using D_Float).
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 88194b3..17c9317 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1085,6 +1085,18 @@ package Opt is
    --  True if output of list of objects is requested (-O switch set). List is
    --  output under the given filename, or standard output if not specified.
 
+   Partition_Elaboration_Policy : Character := ' ';
+   --  GNAT, GNATBIND
+   --  Set to ' ' for the default case (no elaboration policy specified). Reset
+   --  to first character (uppercase) of locking policy name if a valid pragma
+   --  Partition_Elaboration_Policy is encountered.
+
+   Partition_Elaboration_Policy_Sloc : Source_Ptr := No_Location;
+   --  GNAT, GNATBIND
+   --  Remember location of previous Partition_Elaboration_Policy pragma. This
+   --  is used for inconsistency error messages. A value of System_Location is
+   --  used if the policy is set in package System.
+
    Persistent_BSS_Mode : Boolean := False;
    --  GNAT
    --  True if a Persistent_BSS configuration pragma is in effect, causing
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 79d57a3..5bbf914 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1202,6 +1202,7 @@ begin
            Pragma_Optimize_Alignment             |
            Pragma_Overflow_Checks                |
            Pragma_Pack                           |
+           Pragma_Partition_Elaboration_Policy   |
            Pragma_Passive                        |
            Pragma_Preelaborable_Initialization   |
            Pragma_Polling                        |
diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads
index af7030e..b6639b1 100644
--- a/gcc/ada/s-tarest.ads
+++ b/gcc/ada/s-tarest.ads
@@ -167,6 +167,10 @@ package System.Tasking.Restricted.Stages is
    --  Created_Task is the resulting task.
    --
    --  This procedure can raise Storage_Error if the task creation fails
+   --
+   --  Contrary to Create_Task, there is no Chain parameter (for the activation
+   --  chain), as there is only one global activation chain, which is declared
+   --  in the body of this package.
 
    procedure Activate_Tasks;
    pragma Export (C, Activate_Tasks, "__gnat_activate_tasks");
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 895af93..ffebc9b 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11468,10 +11468,19 @@ package body Sem_Ch6 is
          --  public subprogram, since we do get initializations to deal with.
          --  Other internally generated subprograms are not public.
 
-         if not Is_List_Member (DD) and then Is_Init_Proc (DD) then
+         if not Is_List_Member (DD)
+           and then Is_Init_Proc (Defining_Entity (DD))
+         then
             return True;
 
-         elsif not Comes_From_Source (DD) then
+         --  The declaration may have been generated for an expression function
+         --  so check whether that function comes from source.
+
+         elsif not Comes_From_Source (DD)
+           and then
+             (Nkind (Original_Node (DD)) /= N_Expression_Function
+               or else not Comes_From_Source (Defining_Entity (DD)))
+         then
             return False;
 
          --  Otherwise we test whether the subprogram is declared in the
@@ -11797,7 +11806,7 @@ package body Sem_Ch6 is
       end if;
 
       --  If we had any postconditions and expansion is enabled, or if the
-      --  procedure has invariants, then build the _Postconditions procedure.
+      --  subprogram has invariants, then build the _Postconditions procedure.
 
       if (Present (Plist) or else Invariants_Or_Predicates_Present)
         and then Expander_Active
@@ -11806,7 +11815,7 @@ package body Sem_Ch6 is
             Plist := Empty_List;
          end if;
 
-         --  Special processing for function case
+         --  Special processing for function return
 
          if Ekind (Designator) /= E_Procedure then
             declare
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index af5506a..e5dfde9 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -505,6 +505,10 @@ package body Sem_Prag is
       --  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);
@@ -1190,6 +1194,22 @@ package body Sem_Prag is
          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 --
       -------------------------
@@ -12039,6 +12059,53 @@ package body Sem_Prag is
          when Pragma_Page =>
             null;
 
+         ----------------------------------
+         -- Partition_Elaboration_Policy --
+         ----------------------------------
+
+         --  pragma Partition_Elaboration_Policy (policy_IDENTIFIER);
+
+         when Pragma_Partition_Elaboration_Policy => declare
+            subtype PEP_Range is Name_Id
+              range First_Partition_Elaboration_Policy_Name
+                 .. Last_Partition_Elaboration_Policy_Name;
+            PEP_Val : PEP_Range;
+            PEP     : Character;
+
+         begin
+            Ada_2005_Pragma;
+            Check_Arg_Count (1);
+            Check_No_Identifiers;
+            Check_Arg_Is_Partition_Elaboration_Policy (Arg1);
+            Check_Valid_Configuration_Pragma;
+            PEP_Val := Chars (Get_Pragma_Arg (Arg1));
+
+            case PEP_Val is
+               when Name_Concurrent =>
+                  PEP := 'C';
+               when Name_Sequential =>
+                  PEP := 'S';
+            end case;
+
+            if Partition_Elaboration_Policy /= ' '
+              and then Partition_Elaboration_Policy /= PEP
+            then
+               Error_Msg_Sloc := Partition_Elaboration_Policy_Sloc;
+               Error_Pragma
+                 ("partition elaboration policy incompatible with policy#");
+
+            --  Set new policy, but always preserve System_Location since we
+            --  like the error message with the run time name.
+
+            else
+               Partition_Elaboration_Policy := PEP;
+
+               if Partition_Elaboration_Policy_Sloc /= System_Location then
+                  Partition_Elaboration_Policy_Sloc := Loc;
+               end if;
+            end if;
+         end;
+
          -------------
          -- Passive --
          -------------
@@ -15312,6 +15379,7 @@ package body Sem_Prag is
       Pragma_Ordered                        =>  0,
       Pragma_Pack                           =>  0,
       Pragma_Page                           => -1,
+      Pragma_Partition_Elaboration_Policy   => -1,
       Pragma_Passive                        => -1,
       Pragma_Preelaborable_Initialization   => -1,
       Pragma_Polling                        => -1,
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 05d4277..e314d99 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -419,6 +419,17 @@ package body Snames is
       return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
    end Is_Locking_Policy_Name;
 
+   -------------------------------------
+   -- Is_Partition_Elaboration_Policy --
+   -------------------------------------
+
+   function Is_Partition_Elaboration_Policy_Name (N : Name_Id)
+      return Boolean is
+   begin
+      return N in First_Partition_Elaboration_Policy_Name
+           ..  Last_Partition_Elaboration_Policy_Name;
+   end Is_Partition_Elaboration_Policy_Name;
+
    -----------------------------
    -- Is_Operator_Symbol_Name --
    -----------------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index bae9c07..c187600 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -409,6 +409,7 @@ package Snames is
    Name_Normalize_Scalars              : constant Name_Id := N + $;
    Name_Optimize_Alignment             : constant Name_Id := N + $; -- GNAT
    Name_Overflow_Checks                : constant Name_Id := N + $; -- GNAT
+   Name_Partition_Elaboration_Policy   : constant Name_Id := N + $; -- Ada 05
    Name_Persistent_BSS                 : constant Name_Id := N + $; -- GNAT
    Name_Polling                        : constant Name_Id := N + $; -- GNAT
    Name_Priority_Specific_Dispatching  : constant Name_Id := N + $; -- Ada 05
@@ -1015,6 +1016,17 @@ package Snames is
    Name_Round_Robin_Within_Priorities    : constant Name_Id := N + $;
    Last_Task_Dispatching_Policy_Name     : constant Name_Id := N + $;
 
+   --  Names of recognized partition elaboration policy identifiers
+
+   --  Note: policies are identified by the first character of the name (e.g. S
+   --  for Sequential). If new policy names are added, the first character must
+   --  be distinct.
+
+   First_Partition_Elaboration_Policy_Name : constant Name_Id := N + $;
+   Name_Concurrent                         : constant Name_Id := N + $;
+   Name_Sequential                         : constant Name_Id := N + $;
+   Last_Partition_Elaboration_Policy_Name  : constant Name_Id := N + $;
+
    --  Names of recognized checks for pragma Suppress
 
    --  Note: the name Atomic_Synchronization can only be specified internally
@@ -1666,6 +1678,7 @@ package Snames is
       Pragma_Normalize_Scalars,
       Pragma_Optimize_Alignment,
       Pragma_Overflow_Checks,
+      Pragma_Partition_Elaboration_Policy,
       Pragma_Persistent_BSS,
       Pragma_Polling,
       Pragma_Priority_Specific_Dispatching,
@@ -1902,6 +1915,10 @@ package Snames is
    function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of a recognized locking policy
 
+   function Is_Partition_Elaboration_Policy_Name (N : Name_Id) return Boolean;
+   --  Test to see if the name N is the name of a recognized partition
+   --  elaboration policy.
+
    function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of an operator symbol
 
@@ -1978,6 +1995,7 @@ private
    pragma Inline (Is_Entity_Attribute_Name);
    pragma Inline (Is_Type_Attribute_Name);
    pragma Inline (Is_Locking_Policy_Name);
+   pragma Inline (Is_Partition_Elaboration_Policy_Name);
    pragma Inline (Is_Operator_Symbol_Name);
    pragma Inline (Is_Queuing_Policy_Name);
    pragma Inline (Is_Pragma_Name);
diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb
index eea7fcb..2bc2932 100644
--- a/gcc/ada/xr_tabls.adb
+++ b/gcc/ada/xr_tabls.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2012, 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- --
@@ -223,6 +223,7 @@ package body Xr_Tabls is
       Line         : Natural;
       Column       : Natural;
       Decl_Type    : Character;
+      Is_Parameter : Boolean := False;
       Remove_Only  : Boolean := False;
       Symbol_Match : Boolean := True)
       return         Declaration_Reference
@@ -235,7 +236,7 @@ package body Xr_Tabls is
       New_Decl : Declaration_Reference :=
                    Entities_HTable.Get (Key'Unchecked_Access);
 
-      Is_Parameter : Boolean := False;
+      Is_Param : Boolean := Is_Parameter;
 
    begin
       --  Insert the Declaration in the table. There might already be a
@@ -243,7 +244,7 @@ package body Xr_Tabls is
       --  need to check that first.
 
       if New_Decl /= null and then New_Decl.Symbol_Length = 0 then
-         Is_Parameter := New_Decl.Is_Parameter;
+         Is_Param := Is_Parameter or else New_Decl.Is_Parameter;
          Entities_HTable.Remove (Key'Unrestricted_Access);
          Entities_Count := Entities_Count - 1;
          Free (New_Decl.Key);
@@ -269,7 +270,7 @@ package body Xr_Tabls is
                                       Column        => Column,
                                       Source_Line   => null,
                                       Next          => null),
-              Is_Parameter  => Is_Parameter,
+              Is_Parameter  => Is_Param,
               Decl_Type     => Decl_Type,
               Body_Ref      => null,
               Ref_Ref       => null,
@@ -294,6 +295,10 @@ package body Xr_Tabls is
       then
          New_Decl.Match := Default_Match
            or else Match (File_Ref, Line, Column);
+         New_Decl.Is_Parameter := New_Decl.Is_Parameter or else Is_Param;
+
+      elsif New_Decl /= null then
+         New_Decl.Is_Parameter := New_Decl.Is_Parameter or else Is_Param;
       end if;
 
       return New_Decl;
@@ -392,6 +397,8 @@ package body Xr_Tabls is
       Labels_As_Ref : Boolean)
    is
       New_Ref : Reference;
+      New_Decl : Declaration_Reference;
+      pragma Unreferenced (New_Decl);
 
    begin
       case Ref_Type is
@@ -407,36 +414,21 @@ package body Xr_Tabls is
          when '=' | '<' | '>' | '^' =>
 
             --  Create a dummy declaration in the table to report it as a
-            --  parameter. Note that the current declaration for the subprogram
-            --  comes before the declaration of the parameter.
-
-            declare
-               Key      : constant String :=
-                            Key_From_Ref (File_Ref, Line, Column);
-               New_Decl : Declaration_Reference;
-
-            begin
-               New_Decl := new Declaration_Record'
-                 (Symbol_Length => 0,
-                  Symbol        => "",
-                  Key           => new String'(Key),
-                  Decl          => new Reference_Record'
-                                     (File          => File_Ref,
-                                      Line          => Line,
-                                      Column        => Column,
-                                      Source_Line   => null,
-                                      Next          => null),
-                  Is_Parameter  => True,
-                  Decl_Type     => ' ',
-                  Body_Ref      => null,
-                  Ref_Ref       => null,
-                  Modif_Ref     => null,
-                  Match         => False,
-                  Par_Symbol    => null,
-                  Next          => null);
-               Entities_HTable.Set (New_Decl);
-               Entities_Count := Entities_Count + 1;
-            end;
+            --  parameter.
+            --  In a given ALI file, the declaration of the subprogram comes
+            --  before the declaration of the parameter. However, it is
+            --  possible that another ALI file has been parsed that also
+            --  references the parameter (for instance a named parameter in a
+            --  call), so we need to check whether there already exists a
+            --  declaration for the parameter.
+
+            New_Decl := Add_Declaration
+              (File_Ref  => File_Ref,
+               Symbol    => "",
+               Line      => Line,
+               Column    => Column,
+               Decl_Type => ' ',
+               Is_Parameter => True);
 
          when 'e' | 'z' | 't' | 'p' | 'P' | 'k' | 'd' =>
             return;
diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads
index d5e9c5e..9aa47bc 100644
--- a/gcc/ada/xr_tabls.ads
+++ b/gcc/ada/xr_tabls.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1998-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2012, 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- --
@@ -78,6 +78,7 @@ package Xr_Tabls is
       Line         : Natural;
       Column       : Natural;
       Decl_Type    : Character;
+      Is_Parameter : Boolean := False;
       Remove_Only  : Boolean := False;
       Symbol_Match : Boolean := True)
       return         Declaration_Reference;
@@ -89,6 +90,8 @@ package Xr_Tabls is
    --  the command line. In that case, the entity will not be output by
    --  gnatfind. If Symbol_Match is True, the entity will only be output if the
    --  file name itself matches.
+   --  Is_Parameter should be set to True if the entity is known to be a
+   --  subprogram parameter.
 
    procedure Add_Parent
      (Declaration : in out Declaration_Reference;