[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

gcc/ada/ChangeLog

+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

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;

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

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;
 

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

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;

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

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

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);

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;

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);

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);
 

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

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