[multiple changes]

2012-07-23  Vincent Celier  <celier@adacore.com>

	* g-spitbo.adb (Substr (String)): Return full string and do not
	raise exception when Start is 1 and Len is exactly the length
	of the string parameter.
	* g-spitbo.ads: Fix spelling error in the name of exception
	Index_Error.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* par.adb: new subprogram Get_Aspect_Specifications.
	* par-ch6.adb (P_Subprogram): handle subprogram bodies with aspect
	specifications.
	* par-ch13.adb (Get_Aspect_Specifications): extracted from
	P_Aspect_Specifications. Collect aspect specifications in some
	legal context, but do not attach them to any declaration. Used
	when parsing subprogram declarations or bodies that include
	aspect specifications.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): If aspects are
	present, analyze them, or reject them if the subprogram as a
	previous spec.

2012-07-23  Vasiliy Fofanov  <fofanov@adacore.com>

	* gnat_ugn.texi: Omit section on other platforms/runtimes support
	in gnattest for vms version.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications):
	Handle properly aspects that can be specified on a subprogram
	body: CPU, Priority, and Interrupt_Priority.

2012-07-23  Claire Dross  <dross@adacore.com>

	* a-cfdlli.ads: Switch definition of Constant_Reference_Type
	and Empty_List.

2012-07-23  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb (Process_Decisions.Output_Header): For the guard
	on an alternative in a SELECT statement, use the First_Sloc
	of the guard expression (not its topmost sloc) as the decision
	location, because this is what is referenced by dominance markers.

2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Requires_Hooking): Examine the original expression
	of an object declaration node because a function call that
	returns on the secondary stack may have been rewritten into
	something else.

2012-07-23  Vincent Pucci  <pucci@adacore.com>

	* sem_dim.adb (Analyze_Dimension_Has_Etype): For identifier, propagate
	dimension when entity is a non-dimensionless constant.
	(Analyze_Dimension_Object_Declaration): Propagate
	dimension from the expression to the entity when type is a
	dimensioned type and object is a constant.

2012-07-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Old): if the prefix
	is not an entity name, expand at once so that code generated by
	the expansion of the prefix is not generated before the constant
	that captures the old value is properly inserted and analyzed.

2012-07-23  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Ensure_Statement_Present): Mark generated NULL
	statement as Comes_From_Source so that GIGI does not eliminate it.

From-SVN: r189773

15 files changed, 482 insertions, 262 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b24acec..eda6cbb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,75 @@
+2012-07-23  Vincent Celier  <celier@adacore.com>
+
+	* g-spitbo.adb (Substr (String)): Return full string and do not
+	raise exception when Start is 1 and Len is exactly the length
+	of the string parameter.
+	* g-spitbo.ads: Fix spelling error in the name of exception
+	Index_Error.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* par.adb: new subprogram Get_Aspect_Specifications.
+	* par-ch6.adb (P_Subprogram): handle subprogram bodies with aspect
+	specifications.
+	* par-ch13.adb (Get_Aspect_Specifications): extracted from
+	P_Aspect_Specifications. Collect aspect specifications in some
+	legal context, but do not attach them to any declaration. Used
+	when parsing subprogram declarations or bodies that include
+	aspect specifications.
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): If aspects are
+	present, analyze them, or reject them if the subprogram as a
+	previous spec.
+
+2012-07-23  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* gnat_ugn.texi: Omit section on other platforms/runtimes support
+	in gnattest for vms version.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications):
+	Handle properly aspects that can be specified on a subprogram
+	body: CPU, Priority, and Interrupt_Priority.
+
+2012-07-23  Claire Dross  <dross@adacore.com>
+
+	* a-cfdlli.ads: Switch definition of Constant_Reference_Type
+	and Empty_List.
+
+2012-07-23  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb (Process_Decisions.Output_Header): For the guard
+	on an alternative in a SELECT statement, use the First_Sloc
+	of the guard expression (not its topmost sloc) as the decision
+	location, because this is what is referenced by dominance markers.
+
+2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Requires_Hooking): Examine the original expression
+	of an object declaration node because a function call that
+	returns on the secondary stack may have been rewritten into
+	something else.
+
+2012-07-23  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_dim.adb (Analyze_Dimension_Has_Etype): For identifier, propagate
+	dimension when entity is a non-dimensionless constant.
+	(Analyze_Dimension_Object_Declaration): Propagate
+	dimension from the expression to the entity when type is a
+	dimensioned type and object is a constant.
+
+2012-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Old): if the prefix
+	is not an entity name, expand at once so that code generated by
+	the expansion of the prefix is not generated before the constant
+	that captures the old value is properly inserted and analyzed.
+
+2012-07-23  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch9.adb (Ensure_Statement_Present): Mark generated NULL
+	statement as Comes_From_Source so that GIGI does not eliminate it.
+
 2012-07-23  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch12.adb (Insert_Freeze_Node_For_Instance): Inst is now
diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads
index 8bf8a3d..67ff3af 100644
--- a/gcc/ada/a-cfdlli.ads
+++ b/gcc/ada/a-cfdlli.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -307,6 +307,9 @@ private
       Node : Count_Type := 0;
    end record;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
    procedure Read
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out Cursor);
@@ -323,7 +326,4 @@ private
 
    No_Element : constant Cursor := (Node => 0);
 
-   type Constant_Reference_Type
-      (Element : not null access constant Element_Type) is null record;
-
 end Ada.Containers.Formal_Doubly_Linked_Lists;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 9be3a18..6483c7e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4369,12 +4369,16 @@ package body Exp_Ch7 is
          function Requires_Hooking return Boolean is
          begin
             --  The context is either a procedure or function call or an object
-            --  declaration initialized by a function call. In all these cases,
-            --  the calls might raise an exception.
+            --  declaration initialized by a function call. Note that in the
+            --  latter case, a function call that returns on the secondary
+            --  stack is usually rewritten into something else. Its proper
+            --  detection requires examination of the original initialization
+            --  expression.
 
             return Nkind (N) in N_Subprogram_Call
-               or else (Nkind (N) = N_Object_Declaration
-                         and then Nkind (Expression (N)) = N_Function_Call);
+              or else (Nkind (N) = N_Object_Declaration
+                         and then Nkind (Original_Node (Expression (N))) =
+                                    N_Function_Call);
          end Requires_Hooking;
 
          --  Local variables
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 6f37b78..2930604 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -5484,11 +5484,19 @@ package body Exp_Ch9 is
    ------------------------------
 
    procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
+      Stmt : Node_Id;
    begin
       if Opt.Suppress_Control_Flow_Optimizations
         and then Is_Empty_List (Statements (Alt))
       then
-         Set_Statements (Alt, New_List (Make_Null_Statement (Loc)));
+         Stmt := Make_Null_Statement (Loc);
+
+         --  Mark NULL statement as coming from source so that it is not
+         --  eliminated by GIGI.
+
+         Set_Comes_From_Source (Stmt, True);
+
+         Set_Statements (Alt, New_List (Stmt));
       end if;
    end Ensure_Statement_Present;
 
diff --git a/gcc/ada/g-spitbo.adb b/gcc/ada/g-spitbo.adb
index 22677d7..2267714 100644
--- a/gcc/ada/g-spitbo.adb
+++ b/gcc/ada/g-spitbo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1998-2010, AdaCore                     --
+--                     Copyright (C) 1998-2012, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -305,7 +305,7 @@ package body GNAT.Spitbol is
    begin
       if Start > Str'Length then
          raise Index_Error;
-      elsif Start + Len > Str'Length then
+      elsif Start + Len - 1 > Str'Length then
          raise Length_Error;
       else
          return
diff --git a/gcc/ada/g-spitbo.ads b/gcc/ada/g-spitbo.ads
index 94068f8..e97bb62 100644
--- a/gcc/ada/g-spitbo.ads
+++ b/gcc/ada/g-spitbo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1997-2010, AdaCore                     --
+--                     Copyright (C) 1997-2012, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -180,7 +180,7 @@ package GNAT.Spitbol is
    --  Returns the substring starting at the given character position (which
    --  is always counted from the start of the string, regardless of bounds,
    --  e.g. 2 means starting with the second character of the string), and
-   --  with the length (Len) given. Indexing_Error is raised if the starting
+   --  with the length (Len) given. Index_Error is raised if the starting
    --  position is out of range, and Length_Error is raised if Len is too long.
 
    function Trim (Str : VString) return VString;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 934db21..e440ed5 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -487,7 +487,9 @@ Creating Unit Tests Using gnattest
 * Tagged Types Substitutability Testing::
 * Testing with Contracts::
 * Additional Tests::
+@ifclear vms
 * Support for other platforms/run-times::
+@end ifclear
 * Current Limitations::
 
 Other Utility Programs
@@ -18107,7 +18109,9 @@ is installed at its default location.
 * Tagged Types Substitutability Testing::
 * Testing with Contracts::
 * Additional Tests::
+@ifclear vms
 * Support for other platforms/run-times::
+@end ifclear
 * Current Limitations::
 @end menu
 
@@ -18621,6 +18625,7 @@ gnatmake -Pmixing/test_driver.gpr
 mixing/test_runner
 @end smallexample
 
+@ifclear vms
 @node Support for other platforms/run-times
 @section Support for other platforms/run-times
 
@@ -18641,6 +18646,7 @@ the ZFP run-time library:
 @smallexample
 powerpc-elf-gnattest -Psimple.gpr -XPLATFORM=powerpc-elf -XRUNTIME=zfp
 @end smallexample
+@end ifclear
 
 @node Current Limitations
 @section Current Limitations
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 8b2d3d4..2a257f5 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -132,6 +132,251 @@ package body Ch13 is
       return Result;
    end Aspect_Specifications_Present;
 
+   -------------------------------
+   -- Get_Aspect_Specifications --
+   -------------------------------
+
+   function Get_Aspect_Specifications
+     (Semicolon : Boolean := True) return List_Id
+   is
+      Aspects : List_Id;
+      Aspect  : Node_Id;
+      A_Id    : Aspect_Id;
+      OK      : Boolean;
+
+   begin
+      Aspects := Empty_List;
+
+      --  Check if aspect specification present
+
+      if not Aspect_Specifications_Present then
+         if Semicolon then
+            TF_Semicolon;
+         end if;
+
+         return Aspects;
+      end if;
+
+      Scan; -- past WITH
+      Aspects := Empty_List;
+
+      loop
+         OK := True;
+
+         if Token /= Tok_Identifier then
+            Error_Msg_SC ("aspect identifier expected");
+
+            if Semicolon then
+               Resync_Past_Semicolon;
+            end if;
+
+            return Aspects;
+         end if;
+
+         --  We have an identifier (which should be an aspect identifier)
+
+         A_Id := Get_Aspect_Id (Token_Name);
+         Aspect :=
+           Make_Aspect_Specification (Token_Ptr,
+             Identifier => Token_Node);
+
+         --  No valid aspect identifier present
+
+         if A_Id = No_Aspect then
+            Error_Msg_SC ("aspect identifier expected");
+
+            --  Check bad spelling
+
+            for J in Aspect_Id loop
+               if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
+                  Error_Msg_Name_1 := Aspect_Names (J);
+                  Error_Msg_SC -- CODEFIX
+                    ("\possible misspelling of%");
+                  exit;
+               end if;
+            end loop;
+
+            Scan; -- past incorrect identifier
+
+            if Token = Tok_Apostrophe then
+               Scan; -- past '
+               Scan; -- past presumably CLASS
+            end if;
+
+            if Token = Tok_Arrow then
+               Scan; -- Past arrow
+               Set_Expression (Aspect, P_Expression);
+               OK := False;
+
+            elsif Token = Tok_Comma then
+               OK := False;
+
+            else
+               if Semicolon then
+                  Resync_Past_Semicolon;
+               end if;
+
+               return Aspects;
+            end if;
+
+         --  OK aspect scanned
+
+         else
+            Scan; -- past identifier
+
+            --  Check for 'Class present
+
+            if Token = Tok_Apostrophe then
+               if not Class_Aspect_OK (A_Id) then
+                  Error_Msg_Node_1 := Identifier (Aspect);
+                  Error_Msg_SC ("aspect& does not permit attribute here");
+                  Scan; -- past apostrophe
+                  Scan; -- past presumed CLASS
+                  OK := False;
+
+               else
+                  Scan; -- past apostrophe
+
+                  if Token /= Tok_Identifier
+                    or else Token_Name /= Name_Class
+                  then
+                     Error_Msg_SC ("Class attribute expected here");
+                     OK := False;
+
+                     if Token = Tok_Identifier then
+                        Scan; -- past identifier not CLASS
+                     end if;
+
+                  else
+                     Scan; -- past CLASS
+                     Set_Class_Present (Aspect);
+                  end if;
+               end if;
+            end if;
+
+            --  Test case of missing aspect definition
+
+            if Token = Tok_Comma
+              or else Token = Tok_Semicolon
+            then
+               if Aspect_Argument (A_Id) /= Optional then
+                  Error_Msg_Node_1 := Identifier (Aspect);
+                  Error_Msg_AP ("aspect& requires an aspect definition");
+                  OK := False;
+               end if;
+
+            elsif not Semicolon and then Token /= Tok_Arrow then
+               if Aspect_Argument (A_Id) /= Optional then
+
+                  --  The name or expression may be there, but the arrow is
+                  --  missing. Skip to the end of the declaration.
+
+                  T_Arrow;
+                  Resync_To_Semicolon;
+               end if;
+
+            --  Here we have an aspect definition
+
+            else
+               if Token = Tok_Arrow then
+                  Scan; -- past arrow
+               else
+                  T_Arrow;
+                  OK := False;
+               end if;
+
+               if Aspect_Argument (A_Id) = Name then
+                  Set_Expression (Aspect, P_Name);
+               else
+                  Set_Expression (Aspect, P_Expression);
+               end if;
+            end if;
+
+            --  If OK clause scanned, add it to the list
+
+            if OK then
+               Append (Aspect, Aspects);
+            end if;
+
+            if Token = Tok_Comma then
+               Scan; -- past comma
+               goto Continue;
+
+            --  Recognize the case where a comma is missing between two
+            --  aspects, issue an error and proceed with next aspect.
+
+            elsif Token = Tok_Identifier
+              and then Get_Aspect_Id (Token_Name) /= No_Aspect
+            then
+               declare
+                  Scan_State : Saved_Scan_State;
+
+               begin
+                  Save_Scan_State (Scan_State);
+                  Scan; -- past identifier
+
+                  if Token = Tok_Arrow then
+                     Restore_Scan_State (Scan_State);
+                     Error_Msg_AP -- CODEFIX
+                       ("|missing "",""");
+                     goto Continue;
+
+                  else
+                     Restore_Scan_State (Scan_State);
+                  end if;
+               end;
+
+            --  Recognize the case where a semicolon was mistyped for a comma
+            --  between two aspects, issue an error and proceed with next
+            --  aspect.
+
+            elsif Token = Tok_Semicolon then
+               declare
+                  Scan_State : Saved_Scan_State;
+
+               begin
+                  Save_Scan_State (Scan_State);
+                  Scan; -- past semicolon
+
+                  if Token = Tok_Identifier
+                    and then Get_Aspect_Id (Token_Name) /= No_Aspect
+                  then
+                     Scan; -- past identifier
+
+                     if Token = Tok_Arrow then
+                        Restore_Scan_State (Scan_State);
+                        Error_Msg_SC -- CODEFIX
+                          ("|"";"" should be "",""");
+                        Scan; -- past semicolon
+                        goto Continue;
+
+                     else
+                        Restore_Scan_State (Scan_State);
+                     end if;
+
+                  else
+                     Restore_Scan_State (Scan_State);
+                  end if;
+               end;
+            end if;
+
+            --  Must be terminator character
+
+            if Semicolon then
+               T_Semicolon;
+            end if;
+
+            exit;
+
+         <<Continue>>
+            null;
+         end if;
+      end loop;
+
+      return Aspects;
+
+   end Get_Aspect_Specifications;
+
    --------------------------------------------
    -- 13.1  Representation Clause (also I.7) --
    --------------------------------------------
@@ -397,244 +642,19 @@ package body Ch13 is
       Semicolon : Boolean := True)
    is
       Aspects : List_Id;
-      Aspect  : Node_Id;
-      A_Id    : Aspect_Id;
-      OK      : Boolean;
       Ptr     : Source_Ptr;
 
    begin
-      --  Check if aspect specification present
-
-      if not Aspect_Specifications_Present then
-         if Semicolon then
-            TF_Semicolon;
-         end if;
-
-         return;
-      end if;
 
       --  Aspect Specification is present
 
       Ptr := Token_Ptr;
-      Scan; -- past WITH
 
       --  Here we have an aspect specification to scan, note that we don't
       --  set the flag till later, because it may turn out that we have no
       --  valid aspects in the list.
 
-      Aspects := Empty_List;
-      loop
-         OK := True;
-
-         if Token /= Tok_Identifier then
-            Error_Msg_SC ("aspect identifier expected");
-
-            if Semicolon then
-               Resync_Past_Semicolon;
-            end if;
-
-            return;
-         end if;
-
-         --  We have an identifier (which should be an aspect identifier)
-
-         A_Id := Get_Aspect_Id (Token_Name);
-         Aspect :=
-           Make_Aspect_Specification (Token_Ptr,
-             Identifier => Token_Node);
-
-         --  No valid aspect identifier present
-
-         if A_Id = No_Aspect then
-            Error_Msg_SC ("aspect identifier expected");
-
-            --  Check bad spelling
-
-            for J in Aspect_Id loop
-               if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
-                  Error_Msg_Name_1 := Aspect_Names (J);
-                  Error_Msg_SC -- CODEFIX
-                    ("\possible misspelling of%");
-                  exit;
-               end if;
-            end loop;
-
-            Scan; -- past incorrect identifier
-
-            if Token = Tok_Apostrophe then
-               Scan; -- past '
-               Scan; -- past presumably CLASS
-            end if;
-
-            if Token = Tok_Arrow then
-               Scan; -- Past arrow
-               Set_Expression (Aspect, P_Expression);
-               OK := False;
-
-            elsif Token = Tok_Comma then
-               OK := False;
-
-            else
-               if Semicolon then
-                  Resync_Past_Semicolon;
-               end if;
-
-               return;
-            end if;
-
-         --  OK aspect scanned
-
-         else
-            Scan; -- past identifier
-
-            --  Check for 'Class present
-
-            if Token = Tok_Apostrophe then
-               if not Class_Aspect_OK (A_Id) then
-                  Error_Msg_Node_1 := Identifier (Aspect);
-                  Error_Msg_SC ("aspect& does not permit attribute here");
-                  Scan; -- past apostrophe
-                  Scan; -- past presumed CLASS
-                  OK := False;
-
-               else
-                  Scan; -- past apostrophe
-
-                  if Token /= Tok_Identifier
-                    or else Token_Name /= Name_Class
-                  then
-                     Error_Msg_SC ("Class attribute expected here");
-                     OK := False;
-
-                     if Token = Tok_Identifier then
-                        Scan; -- past identifier not CLASS
-                     end if;
-
-                  else
-                     Scan; -- past CLASS
-                     Set_Class_Present (Aspect);
-                  end if;
-               end if;
-            end if;
-
-            --  Test case of missing aspect definition
-
-            if Token = Tok_Comma
-              or else Token = Tok_Semicolon
-            then
-               if Aspect_Argument (A_Id) /= Optional then
-                  Error_Msg_Node_1 := Identifier (Aspect);
-                  Error_Msg_AP ("aspect& requires an aspect definition");
-                  OK := False;
-               end if;
-
-            elsif not Semicolon and then Token /= Tok_Arrow then
-               if Aspect_Argument (A_Id) /= Optional then
-
-                  --  The name or expression may be there, but the arrow is
-                  --  missing. Skip to the end of the declaration.
-
-                  T_Arrow;
-                  Resync_To_Semicolon;
-               end if;
-
-            --  Here we have an aspect definition
-
-            else
-               if Token = Tok_Arrow then
-                  Scan; -- past arrow
-               else
-                  T_Arrow;
-                  OK := False;
-               end if;
-
-               if Aspect_Argument (A_Id) = Name then
-                  Set_Expression (Aspect, P_Name);
-               else
-                  Set_Expression (Aspect, P_Expression);
-               end if;
-            end if;
-
-            --  If OK clause scanned, add it to the list
-
-            if OK then
-               Append (Aspect, Aspects);
-            end if;
-
-            if Token = Tok_Comma then
-               Scan; -- past comma
-               goto Continue;
-
-            --  Recognize the case where a comma is missing between two
-            --  aspects, issue an error and proceed with next aspect.
-
-            elsif Token = Tok_Identifier
-              and then Get_Aspect_Id (Token_Name) /= No_Aspect
-            then
-               declare
-                  Scan_State : Saved_Scan_State;
-
-               begin
-                  Save_Scan_State (Scan_State);
-                  Scan; -- past identifier
-
-                  if Token = Tok_Arrow then
-                     Restore_Scan_State (Scan_State);
-                     Error_Msg_AP -- CODEFIX
-                       ("|missing "",""");
-                     goto Continue;
-
-                  else
-                     Restore_Scan_State (Scan_State);
-                  end if;
-               end;
-
-            --  Recognize the case where a semicolon was mistyped for a comma
-            --  between two aspects, issue an error and proceed with next
-            --  aspect.
-
-            elsif Token = Tok_Semicolon then
-               declare
-                  Scan_State : Saved_Scan_State;
-
-               begin
-                  Save_Scan_State (Scan_State);
-                  Scan; -- past semicolon
-
-                  if Token = Tok_Identifier
-                    and then Get_Aspect_Id (Token_Name) /= No_Aspect
-                  then
-                     Scan; -- past identifier
-
-                     if Token = Tok_Arrow then
-                        Restore_Scan_State (Scan_State);
-                        Error_Msg_SC -- CODEFIX
-                          ("|"";"" should be "",""");
-                        Scan; -- past semicolon
-                        goto Continue;
-
-                     else
-                        Restore_Scan_State (Scan_State);
-                     end if;
-
-                  else
-                     Restore_Scan_State (Scan_State);
-                  end if;
-               end;
-            end if;
-
-            --  Must be terminator character
-
-            if Semicolon then
-               T_Semicolon;
-            end if;
-
-            exit;
-
-         <<Continue>>
-            null;
-         end if;
-      end loop;
+      Aspects := Get_Aspect_Specifications (Semicolon);
 
       --  Here if aspects present
 
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index f527dbe..a05e79b 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -154,6 +154,7 @@ package body Ch6 is
    function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id is
       Specification_Node : Node_Id;
       Name_Node          : Node_Id;
+      Aspects            : List_Id;
       Fpart_List         : List_Id;
       Fpart_Sloc         : Source_Ptr;
       Result_Not_Null    : Boolean := False;
@@ -186,6 +187,8 @@ package body Ch6 is
       Scope.Table (Scope.Last).Ecol := Start_Column;
       Scope.Table (Scope.Last).Lreq := False;
 
+      Aspects := Empty_List;
+
       --  Ada 2005: Scan leading NOT OVERRIDING indicator
 
       if Token = Tok_Not then
@@ -810,6 +813,16 @@ package body Ch6 is
                     New_Node (N_Subprogram_Body, Sloc (Specification_Node));
                   Set_Specification (Body_Node, Specification_Node);
 
+                  --  If aspects are present, the specification is parsed as
+                  --  a subprogram declaration, and we jump here after seeing
+                  --  the keyword IS. Attach asspects previously collected to
+                  --  the body.
+
+                  if Is_Non_Empty_List (Aspects) then
+                     Set_Parent (Aspects, Body_Node);
+                     Set_Aspect_Specifications (Body_Node, Aspects);
+                  end if;
+
                   --  In SPARK, a HIDE directive can be placed at the beginning
                   --  of a subprogram implementation, thus hiding the
                   --  subprogram body from SPARK tool-set. No violation of the
@@ -841,7 +854,24 @@ package body Ch6 is
          Decl_Node :=
            New_Node (N_Subprogram_Declaration, Sloc (Specification_Node));
          Set_Specification (Decl_Node, Specification_Node);
-         P_Aspect_Specifications (Decl_Node);
+         Aspects := Get_Aspect_Specifications (Semicolon => False);
+
+         --  Aspects may be present on a subprogram body. The source parsed
+         --  so far is that of its specification, go parse the body and attach
+         --  the collected aspects, if any, to the body.
+
+         if Token = Tok_Is then
+            Scan;
+            goto Subprogram_Body;
+
+         else
+            if Is_Non_Empty_List (Aspects) then
+               Set_Parent (Aspects, Decl_Node);
+               Set_Aspect_Specifications (Decl_Node, Aspects);
+            end if;
+
+            TF_Semicolon;
+         end if;
 
          --  If this is a context in which a subprogram body is permitted,
          --  set active SIS entry in case (see section titled "Handling
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 3f9d541..892aac8 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -876,6 +876,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  for aspects so it does not matter whether the aspect specifications
       --  are terminated by semicolon or some other character.
 
+      function Get_Aspect_Specifications
+        (Semicolon : Boolean := True) return List_Id;
+      --  Parse a list of aspects but do not attach them to a declaration node.
+      --  Subsidiary to the following procedure. Used when parsing a subprogram
+      --  specification that may be a declaration or a body.
+
       procedure P_Aspect_Specifications
         (Decl      : Node_Id;
          Semicolon : Boolean := True);
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 766621a..fd1d887 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -25,6 +25,7 @@
 
 with Atree;    use Atree;
 with Debug;    use Debug;
+with Errout;   use Errout;
 with Lib;      use Lib;
 with Lib.Util; use Lib.Util;
 with Namet;    use Namet;
@@ -495,13 +496,15 @@ package body Par_SCO is
                --  levels (through the pragma argument association) to get to
                --  the pragma node itself. For the guard on a select
                --  alternative, we do not have access to the token location
-               --  for the WHEN, so we use the sloc of the condition itself.
+               --  for the WHEN, so we use the first sloc of the condition
+               --  itself (note: we use First_Sloc, not Sloc, because this is
+               --  what is referenced by dominance markers).
 
                if Nkind_In (Parent (N), N_Accept_Alternative,
                                         N_Delay_Alternative,
                                         N_Terminate_Alternative)
                then
-                  Loc := Sloc (N);
+                  Loc := First_Sloc (N);
                else
                   Loc := Sloc (Parent (Parent (N)));
                end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index af1a817..e1abe5a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4026,14 +4026,15 @@ package body Sem_Attr is
          --  an entity in the enclosing subprogram. If it is a component of
          --  a formal its expansion might generate actual subtypes that may
          --  be referenced in an inner context, and which must be elaborated
-         --  within the subprogram itself. As a result we create a
-         --  declaration for it and insert it at the start of the enclosing
-         --  subprogram. This is properly an expansion activity but it has
-         --  to be performed now to prevent out-of-order issues.
-
-         if Nkind (P) = N_Selected_Component
-           and then Has_Discriminants (Etype (Prefix (P)))
-         then
+         --  within the subprogram itself. If the prefix includes a function
+         --  call it may involve finalization actions that should only be
+         --  inserted when the attribute has been rewritten as a declarations.
+         --  As a result, if the prefix is not a simple name we create a
+         --  declaration for it now,  and insert it at the start of the
+         --  enclosing subprogram. This is properly an expansion activity but
+         --  it has to be performed now to prevent out-of-order issues.
+
+         if not Is_Entity_Name (P) then
             P_Type := Base_Type (P_Type);
             Set_Etype (N, P_Type);
             Set_Etype (P, P_Type);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d68eeaf..df61549 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1150,17 +1150,14 @@ package body Sem_Ch13 is
                     Aspect_Bit_Order            |
                     Aspect_Component_Size       |
                     Aspect_Constant_Indexing    |
-                    Aspect_CPU                  |
                     Aspect_Default_Iterator     |
                     Aspect_Dispatching_Domain   |
                     Aspect_External_Tag         |
                     Aspect_Input                |
-                    Aspect_Interrupt_Priority   |
                     Aspect_Iterator_Element     |
                     Aspect_Machine_Radix        |
                     Aspect_Object_Size          |
                     Aspect_Output               |
-                    Aspect_Priority             |
                     Aspect_Read                 |
                     Aspect_Scalar_Storage_Order |
                     Aspect_Size                 |
@@ -1341,6 +1338,29 @@ package body Sem_Ch13 is
                             Make_Identifier (Loc, P_Name));
                   end;
 
+               --  The following three aspects can be specified for a
+               --  subprogram body, in which case we generate pragmas for them
+               --  and insert them ahead of local declarations, rather than
+               --  after the body.
+
+               when Aspect_CPU                |
+                    Aspect_Interrupt_Priority |
+                    Aspect_Priority           =>
+                  if Nkind (N) = N_Subprogram_Body then
+                     Aitem :=
+                       Make_Pragma (Loc,
+                         Pragma_Argument_Associations =>
+                           New_List (Relocate_Node (Expr)),
+                         Pragma_Identifier            =>
+                           Make_Identifier (Sloc (Id), Chars (Id)));
+                  else
+                     Aitem :=
+                       Make_Attribute_Definition_Clause (Loc,
+                         Name       => Ent,
+                         Chars      => Chars (Id),
+                         Expression => Relocate_Node (Expr));
+                  end if;
+
                when Aspect_Warnings =>
 
                   --  Construct the pragma
@@ -1725,7 +1745,8 @@ package body Sem_Ch13 is
 
             --  In the context of a compilation unit, we directly put the
             --  pragma in the Pragmas_After list of the
-            --  N_Compilation_Unit_Aux node. No delay is required here.
+            --  N_Compilation_Unit_Aux node (No delay is required here)
+            --  except for aspects on a subprogram body (see below).
 
             if Nkind (Parent (N)) = N_Compilation_Unit
               and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -1757,11 +1778,25 @@ package body Sem_Ch13 is
                      end if;
                   end if;
 
-                  if No (Pragmas_After (Aux)) then
-                     Set_Pragmas_After (Aux, Empty_List);
+                  --  If the aspect is on a subprogram body (relevant aspects
+                  --  are Inline and Priority), add the pragma in front of
+                  --  the declarations.
+
+                  if Nkind (N) = N_Subprogram_Body then
+                     if No (Declarations (N)) then
+                        Set_Declarations (N, New_List);
+                     end if;
+
+                     Prepend (Aitem, Declarations (N));
+
+                  else
+                     if No (Pragmas_After (Aux)) then
+                        Set_Pragmas_After (Aux, Empty_List);
+                     end if;
+
+                     Append (Aitem, Pragmas_After (Aux));
                   end if;
 
-                  Append (Aitem, Pragmas_After (Aux));
                   goto Continue;
                end;
             end if;
@@ -3243,10 +3278,11 @@ package body Sem_Ch13 is
 
             if From_Aspect_Specification (N) then
                if not (Is_Protected_Type (U_Ent)
-                        or else Is_Task_Type (U_Ent))
+                        or else Is_Task_Type (U_Ent)
+                        or else Ekind (U_Ent) = E_Procedure)
                then
                   Error_Msg_N
-                    ("Priority can only be defined for task and protected" &
+                    ("Priority can only be defined for task and protected " &
                      "object",
                      Nam);
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index b568ebb..5f06161 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2504,6 +2504,19 @@ package body Sem_Ch6 is
          end if;
       end if;
 
+      --  Ada 2012 aspects may appear in a subprogram body, but only if there
+      --  is no previous spec.
+
+      if Has_Aspects (N) then
+         if Present (Corresponding_Spec (N)) then
+            Error_Msg_N
+              ("aspect specifications must appear in subprogram declaration",
+                N);
+         else
+            Analyze_Aspect_Specifications (N, Body_Id);
+         end if;
+      end if;
+
       --  Previously we scanned the body to look for nested subprograms, and
       --  rejected an inline directive if nested subprograms were present,
       --  because the back-end would generate conflicting symbols for the
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 1d0307c..3d0e1dd 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -1617,6 +1617,14 @@ package body Sem_Dim is
 
       if Exists (Dims_Of_Etyp) then
          Set_Dimensions (N, Dims_Of_Etyp);
+
+      --  Propagation of the dimensions from the entity for identifier whose
+      --  entity is a non-dimensionless consant.
+
+      elsif Nkind (N) = N_Identifier
+        and then Exists (Dimensions_Of (Entity (N)))
+      then
+         Set_Dimensions (N, Dimensions_Of (Entity (N)));
       end if;
 
       --  Removal of dimensions in expression
@@ -1692,7 +1700,7 @@ package body Sem_Dim is
       if Present (Expr) then
          Dim_Of_Expr := Dimensions_Of (Expr);
 
-         --  case when expression is not a literal and when dimensions of the
+         --  Case when expression is not a literal and when dimensions of the
          --  expression and of the type mismatch
 
          if not Nkind_In (Original_Node (Expr),
@@ -1700,7 +1708,20 @@ package body Sem_Dim is
                              N_Integer_Literal)
            and then Dim_Of_Expr /= Dim_Of_Etyp
          then
-            Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
+            --  Propagate the dimension from the expression to the object
+            --  entity when the object is a constant whose type is a
+            --  dimensioned type.
+
+            if Constant_Present (N)
+              and then not Exists (Dim_Of_Etyp)
+            then
+               Set_Dimensions (Id, Dim_Of_Expr);
+
+            --  Otherwise, issue an error message
+
+            else
+               Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
+            end if;
          end if;
 
          --  Removal of dimensions in expression