2012-12-05 Yannick Moy <moy@adacore.com>

	* urealp.ads: Minor rewording.

2012-12-05  Yannick Moy  <moy@adacore.com>

	* aspects.ads (No_Duplicates_Allowed): Forbid use of duplicate
	Contract_Cases aspects.
	* sem_prag.adb (Analyze_Pragma/Pragma_Contract_Case): Rename
	POST_CASE into CONTRACT_CASE in both grammar and code, to be
	consistent with current language definition.  Issue a more precise
	error message when the pragma duplicates another pragma or aspect.

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Add processing
	for attribute Update.
	(Expand_Update_Attribute): New routine.
	* par-ch4.adb (P_Name): The sole expression of attribute Update
	is an aggregate, parse it accordingly.
	* sem_attr.adb (Analyze_Attribute): Verify the legality of
	attribute Update.
	(Eval_Attribute): Attribute Update does not
	need evaluation because it is never static.
	* snames.ads-tmpl: Add Name_Update to the list of special names
	recognized by the compiler. Add an Attribute_Id for Update.

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Remove_Side_Effects): For purposes of removing
	side effects, qualified expressions do not receive a special
	treatment, even though in Ada 2012 they are defined  as object
	references.

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* par-ch3.adb: Minor reformatting.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194207 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 556 insertions, 118 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 802b2dbdf4e..7a46c4d11cb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2012-12-05  Yannick Moy  <moy@adacore.com>
+
+	* urealp.ads: Minor rewording.
+
+2012-12-05  Yannick Moy  <moy@adacore.com>
+
+	* aspects.ads (No_Duplicates_Allowed): Forbid use of duplicate
+	Contract_Cases aspects.
+	* sem_prag.adb (Analyze_Pragma/Pragma_Contract_Case): Rename
+	POST_CASE into CONTRACT_CASE in both grammar and code, to be
+	consistent with current language definition.  Issue a more precise
+	error message when the pragma duplicates another pragma or aspect.
+
+2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference): Add processing
+	for attribute Update.
+	(Expand_Update_Attribute): New routine.
+	* par-ch4.adb (P_Name): The sole expression of attribute Update
+	is an aggregate, parse it accordingly.
+	* sem_attr.adb (Analyze_Attribute): Verify the legality of
+	attribute Update.
+	(Eval_Attribute): Attribute Update does not
+	need evaluation because it is never static.
+	* snames.ads-tmpl: Add Name_Update to the list of special names
+	recognized by the compiler. Add an Attribute_Id for Update.
+
+2012-12-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.adb (Remove_Side_Effects): For purposes of removing
+	side effects, qualified expressions do not receive a special
+	treatment, even though in Ada 2012 they are defined  as object
+	references.
+
+2012-12-05  Thomas Quinot  <quinot@adacore.com>
+
+	* par-ch3.adb: Minor reformatting.
+
 2012-12-05  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index d79252baebf..d896de8bc3e 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -257,7 +257,6 @@ package Aspects is
 
    No_Duplicates_Allowed : constant array (Aspect_Id) of Boolean :=
                              (Aspect_Contract_Case  => False,
-                              Aspect_Contract_Cases => False,
                               Aspect_Test_Case      => False,
                               others                => True);
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index cb31c2276a1..2fa944b7d6f 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -140,6 +140,9 @@ package body Exp_Attr is
    --  Handles expansion of Pred or Succ attributes for case of non-real
    --  operand with overflow checking required.
 
+   procedure Expand_Update_Attribute (N : Node_Id);
+   --  Handle the expansion of attribute Update
+
    function Get_Index_Subtype (N : Node_Id) return Entity_Id;
    --  Used for Last, Last, and Length, when the prefix is an array type.
    --  Obtains the corresponding index subtype.
@@ -5237,6 +5240,13 @@ package body Exp_Attr is
          Analyze_And_Resolve (N, Typ);
       end UET_Address;
 
+      ------------
+      -- Update --
+      ------------
+
+      when Attribute_Update =>
+         Expand_Update_Attribute (N);
+
       ---------------
       -- VADS_Size --
       ---------------
@@ -6160,6 +6170,197 @@ package body Exp_Attr is
       end if;
    end Expand_Pred_Succ;
 
+   -----------------------------
+   -- Expand_Update_Attribute --
+   -----------------------------
+
+   procedure Expand_Update_Attribute (N : Node_Id) is
+      procedure Process_Component_Or_Element_Update
+        (Temp : Entity_Id;
+         Comp : Node_Id;
+         Expr : Node_Id;
+         Typ  : Entity_Id);
+      --  Generate the statements necessary to update a single component or an
+      --  element of the prefix. The code is inserted before the attribute N.
+      --  Temp denotes the entity of the anonymous object created to reflect
+      --  the changes in values. Comp is the component/index expression to be
+      --  updated. Expr is an expression yielding the new value of Comp. Typ
+      --  is the type of the prefix of attribute Update.
+
+      procedure Process_Range_Update
+        (Temp : Entity_Id;
+         Comp : Node_Id;
+         Expr : Node_Id);
+      --  Generate the statements necessary to update a slice of the prefix.
+      --  The code is inserted before the attribute N. Temp denotes the entity
+      --  of the anonymous object created to reflect the changes in values.
+      --  Comp is range of the slice to be updated. Expr is an expression
+      --  yielding the new value of Comp.
+
+      -----------------------------------------
+      -- Process_Component_Or_Element_Update --
+      -----------------------------------------
+
+      procedure Process_Component_Or_Element_Update
+        (Temp : Entity_Id;
+         Comp : Node_Id;
+         Expr : Node_Id;
+         Typ  : Entity_Id)
+      is
+         Loc   : constant Source_Ptr := Sloc (Comp);
+         Exprs : List_Id;
+         LHS   : Node_Id;
+
+      begin
+         --  An array element may be modified by the following relations
+         --  depending on the number of dimensions:
+
+         --     1 => Expr           --  one dimensional update
+         --    (1, ..., N) => Expr  --  multi dimensional update
+
+         --  The above forms are converted in assignment statements where the
+         --  left hand side is an indexed component:
+
+         --    Temp (1) := Expr;          --  one dimensional update
+         --    Temp (1, ..., N) := Expr;  --  multi dimensional update
+
+         if Is_Array_Type (Typ) then
+
+            --  The index expressions of a multi dimensional array update
+            --  appear as an aggregate.
+
+            if Nkind (Comp) = N_Aggregate then
+               Exprs := New_Copy_List_Tree (Expressions (Comp));
+            else
+               Exprs := New_List (Relocate_Node (Comp));
+            end if;
+
+            LHS :=
+              Make_Indexed_Component (Loc,
+                Prefix      => New_Reference_To (Temp, Loc),
+                Expressions => Exprs);
+
+         --  A record component update appears in the following form:
+
+         --    Comp => Expr
+
+         --  The above relation is transformed into an assignment statement
+         --  where the left hand side is a selected component:
+
+         --    Temp.Comp := Expr;
+
+         else pragma Assert (Is_Record_Type (Typ));
+            LHS :=
+              Make_Selected_Component (Loc,
+                Prefix        => New_Reference_To (Temp, Loc),
+                Selector_Name => Relocate_Node (Comp));
+         end if;
+
+         Insert_Action (N,
+           Make_Assignment_Statement (Loc,
+             Name       => LHS,
+             Expression => Relocate_Node (Expr)));
+      end Process_Component_Or_Element_Update;
+
+      --------------------------
+      -- Process_Range_Update --
+      --------------------------
+
+      procedure Process_Range_Update
+        (Temp : Entity_Id;
+         Comp : Node_Id;
+         Expr : Node_Id)
+      is
+         Loc   : constant Source_Ptr := Sloc (Comp);
+         Index : Entity_Id;
+
+      begin
+         --  A range update appears as
+
+         --    (Low .. High => Expr)
+
+         --  The above construct is transformed into a loop that iterates over
+         --  the given range and modifies the corresponding array values to the
+         --  value of Expr:
+
+         --    for Index in Low .. High loop
+         --       Temp (Index) := Expr;
+         --    end loop;
+
+         Index := Make_Temporary (Loc, 'I');
+
+         Insert_Action (N,
+           Make_Loop_Statement (Loc,
+             Iteration_Scheme =>
+               Make_Iteration_Scheme (Loc,
+                 Loop_Parameter_Specification =>
+                   Make_Loop_Parameter_Specification (Loc,
+                     Defining_Identifier         => Index,
+                     Discrete_Subtype_Definition => Relocate_Node (Comp))),
+
+             Statements       => New_List (
+               Make_Assignment_Statement (Loc,
+                 Name       =>
+                   Make_Indexed_Component (Loc,
+                     Prefix      => New_Reference_To (Temp, Loc),
+                     Expressions => New_List (New_Reference_To (Index, Loc))),
+                 Expression => Relocate_Node (Expr))),
+
+             End_Label        => Empty));
+      end Process_Range_Update;
+
+      --  Local variables
+
+      Aggr  : constant Node_Id := First (Expressions (N));
+      Loc   : constant Source_Ptr := Sloc (N);
+      Pref  : constant Node_Id := Prefix (N);
+      Typ   : constant Entity_Id := Etype (Pref);
+      Assoc : Node_Id;
+      Comp  : Node_Id;
+      Expr  : Node_Id;
+      Temp  : Entity_Id;
+
+   --  Start of processing for Expand_Update_Attribute
+
+   begin
+      --  Create the anonymous object that stores the value of the prefix and
+      --  reflects subsequent changes in value. Generate:
+
+      --    Temp : <type of Pref> := Pref;
+
+      Temp := Make_Temporary (Loc, 'T');
+
+      Insert_Action (N,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Temp,
+          Object_Definition   => New_Reference_To (Typ, Loc),
+          Expression          => Relocate_Node (Pref)));
+
+      --  Process the update aggregate
+
+      Assoc := First (Component_Associations (Aggr));
+      while Present (Assoc) loop
+         Comp := First (Choices (Assoc));
+         Expr := Expression (Assoc);
+         while Present (Comp) loop
+            if Nkind (Comp) = N_Range then
+               Process_Range_Update (Temp, Comp, Expr);
+            else
+               Process_Component_Or_Element_Update (Temp, Comp, Expr, Typ);
+            end if;
+
+            Next (Comp);
+         end loop;
+
+         Next (Assoc);
+      end loop;
+
+      --  The attribute is replaced by a reference to the anonymous object
+
+      Rewrite (N, New_Reference_To (Temp, Loc));
+      Analyze (N);
+   end Expand_Update_Attribute;
+
    -------------------
    -- Find_Fat_Info --
    -------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 7c1ceeb8f7e..3a9f81db0fc 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1107,14 +1107,14 @@ package body Exp_Util is
          Temps (J) := T;
 
          Append_To (Decls,
-            Make_Object_Declaration (Loc,
-               Defining_Identifier => T,
-               Object_Definition => New_Occurrence_Of (Standard_String, Loc),
-               Expression =>
-                 Make_Attribute_Reference (Loc,
-                   Attribute_Name => Name_Image,
-                   Prefix         => New_Occurrence_Of (Etype (Indx), Loc),
-                   Expressions    => New_List (New_Copy_Tree (Val)))));
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => T,
+             Object_Definition   => New_Occurrence_Of (Standard_String, Loc),
+             Expression          =>
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_Image,
+                 Prefix         => New_Occurrence_Of (Etype (Indx), Loc),
+                 Expressions    => New_List (New_Copy_Tree (Val)))));
 
          Next_Index (Indx);
          Next (Val);
@@ -1126,22 +1126,21 @@ package body Exp_Util is
         Make_Op_Add (Loc,
           Left_Opnd => Sum,
           Right_Opnd =>
-           Make_Attribute_Reference (Loc,
-             Attribute_Name => Name_Length,
-             Prefix =>
-               New_Occurrence_Of (Pref, Loc),
-             Expressions => New_List (Make_Integer_Literal (Loc, 1))));
+            Make_Attribute_Reference (Loc,
+              Attribute_Name => Name_Length,
+              Prefix         => New_Occurrence_Of (Pref, Loc),
+              Expressions    => New_List (Make_Integer_Literal (Loc, 1))));
 
       for J in 1 .. Dims loop
          Sum :=
-            Make_Op_Add (Loc,
-             Left_Opnd => Sum,
+           Make_Op_Add (Loc,
+             Left_Opnd  => Sum,
              Right_Opnd =>
-              Make_Attribute_Reference (Loc,
-                Attribute_Name => Name_Length,
-                Prefix =>
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name => Name_Length,
+                 Prefix         =>
                   New_Occurrence_Of (Temps (J), Loc),
-                Expressions => New_List (Make_Integer_Literal (Loc, 1))));
+                Expressions     => New_List (Make_Integer_Literal (Loc, 1))));
       end loop;
 
       Build_Task_Image_Prefix (Loc, Len, Res, Pos, Pref, Sum, Decls, Stats);
@@ -1149,44 +1148,46 @@ package body Exp_Util is
       Set_Character_Literal_Name (Char_Code (Character'Pos ('(')));
 
       Append_To (Stats,
-         Make_Assignment_Statement (Loc,
-           Name => Make_Indexed_Component (Loc,
-              Prefix => New_Occurrence_Of (Res, Loc),
+        Make_Assignment_Statement (Loc,
+          Name       =>
+            Make_Indexed_Component (Loc,
+              Prefix      => New_Occurrence_Of (Res, Loc),
               Expressions => New_List (New_Occurrence_Of (Pos, Loc))),
-           Expression =>
-             Make_Character_Literal (Loc,
-               Chars => Name_Find,
-               Char_Literal_Value =>
-                 UI_From_Int (Character'Pos ('(')))));
+          Expression =>
+            Make_Character_Literal (Loc,
+              Chars              => Name_Find,
+              Char_Literal_Value => UI_From_Int (Character'Pos ('(')))));
 
       Append_To (Stats,
-         Make_Assignment_Statement (Loc,
-            Name => New_Occurrence_Of (Pos, Loc),
-            Expression =>
-              Make_Op_Add (Loc,
-                Left_Opnd => New_Occurrence_Of (Pos, Loc),
-                Right_Opnd => Make_Integer_Literal (Loc, 1))));
+        Make_Assignment_Statement (Loc,
+          Name       => New_Occurrence_Of (Pos, Loc),
+          Expression =>
+            Make_Op_Add (Loc,
+              Left_Opnd  => New_Occurrence_Of (Pos, Loc),
+              Right_Opnd => Make_Integer_Literal (Loc, 1))));
 
       for J in 1 .. Dims loop
 
          Append_To (Stats,
-            Make_Assignment_Statement (Loc,
-              Name => Make_Slice (Loc,
-                 Prefix => New_Occurrence_Of (Res, Loc),
+           Make_Assignment_Statement (Loc,
+             Name =>
+               Make_Slice (Loc,
+                 Prefix          => New_Occurrence_Of (Res, Loc),
                  Discrete_Range  =>
                    Make_Range (Loc,
-                      Low_Bound => New_Occurrence_Of  (Pos, Loc),
-                      High_Bound => Make_Op_Subtract (Loc,
-                        Left_Opnd =>
-                          Make_Op_Add (Loc,
-                            Left_Opnd => New_Occurrence_Of (Pos, Loc),
-                            Right_Opnd =>
-                              Make_Attribute_Reference (Loc,
-                                Attribute_Name => Name_Length,
-                                Prefix =>
-                                  New_Occurrence_Of (Temps (J), Loc),
-                                Expressions =>
-                                  New_List (Make_Integer_Literal (Loc, 1)))),
+                     Low_Bound  => New_Occurrence_Of  (Pos, Loc),
+                     High_Bound =>
+                       Make_Op_Subtract (Loc,
+                         Left_Opnd  =>
+                           Make_Op_Add (Loc,
+                             Left_Opnd  => New_Occurrence_Of (Pos, Loc),
+                             Right_Opnd =>
+                               Make_Attribute_Reference (Loc,
+                                 Attribute_Name => Name_Length,
+                                 Prefix         =>
+                                   New_Occurrence_Of (Temps (J), Loc),
+                                 Expressions    =>
+                                   New_List (Make_Integer_Literal (Loc, 1)))),
                          Right_Opnd => Make_Integer_Literal (Loc, 1)))),
 
               Expression => New_Occurrence_Of (Temps (J), Loc)));
@@ -1194,36 +1195,35 @@ package body Exp_Util is
          if J < Dims then
             Append_To (Stats,
                Make_Assignment_Statement (Loc,
-                  Name => New_Occurrence_Of (Pos, Loc),
+                  Name       => New_Occurrence_Of (Pos, Loc),
                   Expression =>
                     Make_Op_Add (Loc,
-                      Left_Opnd => New_Occurrence_Of (Pos, Loc),
+                      Left_Opnd  => New_Occurrence_Of (Pos, Loc),
                       Right_Opnd =>
                         Make_Attribute_Reference (Loc,
                           Attribute_Name => Name_Length,
-                            Prefix => New_Occurrence_Of (Temps (J), Loc),
-                            Expressions =>
-                              New_List (Make_Integer_Literal (Loc, 1))))));
+                          Prefix         => New_Occurrence_Of (Temps (J), Loc),
+                          Expressions    =>
+                            New_List (Make_Integer_Literal (Loc, 1))))));
 
             Set_Character_Literal_Name (Char_Code (Character'Pos (',')));
 
             Append_To (Stats,
-               Make_Assignment_Statement (Loc,
-                 Name => Make_Indexed_Component (Loc,
-                    Prefix => New_Occurrence_Of (Res, Loc),
-                    Expressions => New_List (New_Occurrence_Of (Pos, Loc))),
-                 Expression =>
-                   Make_Character_Literal (Loc,
-                     Chars => Name_Find,
-                     Char_Literal_Value =>
-                       UI_From_Int (Character'Pos (',')))));
+              Make_Assignment_Statement (Loc,
+                Name => Make_Indexed_Component (Loc,
+                   Prefix => New_Occurrence_Of (Res, Loc),
+                   Expressions => New_List (New_Occurrence_Of (Pos, Loc))),
+                Expression =>
+                  Make_Character_Literal (Loc,
+                    Chars              => Name_Find,
+                    Char_Literal_Value => UI_From_Int (Character'Pos (',')))));
 
             Append_To (Stats,
               Make_Assignment_Statement (Loc,
-                Name => New_Occurrence_Of (Pos, Loc),
+                Name         => New_Occurrence_Of (Pos, Loc),
                   Expression =>
                     Make_Op_Add (Loc,
-                      Left_Opnd => New_Occurrence_Of (Pos, Loc),
+                      Left_Opnd  => New_Occurrence_Of (Pos, Loc),
                       Right_Opnd => Make_Integer_Literal (Loc, 1))));
          end if;
       end loop;
@@ -1231,15 +1231,15 @@ package body Exp_Util is
       Set_Character_Literal_Name (Char_Code (Character'Pos (')')));
 
       Append_To (Stats,
-         Make_Assignment_Statement (Loc,
-           Name => Make_Indexed_Component (Loc,
-              Prefix => New_Occurrence_Of (Res, Loc),
+        Make_Assignment_Statement (Loc,
+          Name        =>
+            Make_Indexed_Component (Loc,
+              Prefix      => New_Occurrence_Of (Res, Loc),
               Expressions => New_List (New_Occurrence_Of (Len, Loc))),
            Expression =>
              Make_Character_Literal (Loc,
-               Chars => Name_Find,
-               Char_Literal_Value =>
-                 UI_From_Int (Character'Pos (')')))));
+               Chars              => Name_Find,
+               Char_Literal_Value => UI_From_Int (Character'Pos (')')))));
       return Build_Task_Image_Function (Loc, Decls, Stats, Res);
    end Build_Task_Array_Image;
 
@@ -6842,15 +6842,20 @@ package body Exp_Util is
          end if;
 
       --  For expressions that denote objects, we can use a renaming scheme.
-      --  This is needed for correctness in the case of a volatile object of a
-      --  non-volatile type because the Make_Reference call of the "default"
+      --  This is needed for correctness in the case of a volatile object of
+      --  a non-volatile type because the Make_Reference call of the "default"
       --  approach would generate an illegal access value (an access value
       --  cannot designate such an object - see Analyze_Reference). We skip
       --  using this scheme if we have an object of a volatile type and we do
       --  not have Name_Req set true (see comments above for Side_Effect_Free).
 
+      --  In Ada 2012 a qualified expression is an object, but for purposes of
+      --  removing side effects it still need to be transformed into a separate
+      --  declaration, particularly if the expression is an aggregate.
+
       elsif Is_Object_Reference (Exp)
         and then Nkind (Exp) /= N_Function_Call
+        and then Nkind (Exp) /= N_Qualified_Expression
         and then (Name_Req or else not Treat_As_Volatile (Exp_Type))
       then
          Def_Id := Make_Temporary (Loc, 'R', Exp);
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 728a704f5f6..eae388ba7ae 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -935,7 +935,7 @@ package body Ch3 is
 
    --  SUBTYPE_DECLARATION ::=
    --    subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION
-   --    {ASPECT_SPECIFICATIONS];
+   --      [ASPECT_SPECIFICATIONS];
 
    --  The caller has checked that the initial token is SUBTYPE
 
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 019d5fbc996..8107c89096c 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -510,26 +510,36 @@ package body Ch4 is
                 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
             then
                Set_Expressions (Name_Node, New_List);
-               Scan; -- past left paren
 
-               loop
-                  declare
-                     Expr : constant Node_Id := P_Expression_If_OK;
+               --  Attribute Update contains an array or record association
+               --  list which provides new values for various components or
+               --  elements. The list is parsed as an aggregate.
 
-                  begin
-                     if Token = Tok_Arrow then
-                        Error_Msg_SC
-                          ("named parameters not permitted for attributes");
-                        Scan; -- past junk arrow
+               if Attr_Name = Name_Update then
+                  Append (P_Aggregate, Expressions (Name_Node));
 
-                     else
-                        Append (Expr, Expressions (Name_Node));
-                        exit when not Comma_Present;
-                     end if;
-                  end;
-               end loop;
+               else
+                  Scan; -- past left paren
+
+                  loop
+                     declare
+                        Expr : constant Node_Id := P_Expression_If_OK;
+
+                     begin
+                        if Token = Tok_Arrow then
+                           Error_Msg_SC
+                             ("named parameters not permitted for attributes");
+                           Scan; -- past junk arrow
+
+                        else
+                           Append (Expr, Expressions (Name_Node));
+                           exit when not Comma_Present;
+                        end if;
+                     end;
+                  end loop;
 
-               T_Right_Paren;
+                  T_Right_Paren;
+               end if;
             end if;
 
             goto Scan_Name_Extension;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7803d365558..aa61f85e723 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5516,6 +5516,164 @@ package body Sem_Attr is
 
          Analyze_Access_Attribute;
 
+      ------------
+      -- Update --
+      ------------
+
+      when Attribute_Update => Update : declare
+         Comps : Elist_Id := No_Elist;
+
+         procedure Check_Component_Reference
+           (Comp : Entity_Id;
+            Typ  : Entity_Id);
+         --  Comp is a record component (possibly a discriminant) and Typ is a
+         --  record type. Determine whether Comp is a legal component of Typ.
+         --  Emit an error if Comp mentions a discriminant or is not a unique
+         --  component reference in the update aggregate.
+
+         -------------------------------
+         -- Check_Component_Reference --
+         -------------------------------
+
+         procedure Check_Component_Reference
+           (Comp : Entity_Id;
+            Typ  : Entity_Id)
+         is
+            Comp_Name : constant Name_Id := Chars (Comp);
+
+            function Is_Duplicate_Component return Boolean;
+            --  Determine whether component Comp already appears in list Comps
+
+            ----------------------------
+            -- Is_Duplicate_Component --
+            ----------------------------
+
+            function Is_Duplicate_Component return Boolean is
+               Comp_Elmt : Elmt_Id;
+
+            begin
+               if Present (Comps) then
+                  Comp_Elmt := First_Elmt (Comps);
+                  while Present (Comp_Elmt) loop
+                     if Chars (Node (Comp_Elmt)) = Comp_Name then
+                        return True;
+                     end if;
+
+                     Next_Elmt (Comp_Elmt);
+                  end loop;
+               end if;
+
+               return False;
+            end Is_Duplicate_Component;
+
+            --  Local variables
+
+            Comp_Or_Discr : Entity_Id;
+
+         --  Start of processing for Check_Component_Reference
+
+         begin
+            --  Find the discriminant or component whose name corresponds to
+            --  Comp. A simple character comparison is sufficient because all
+            --  visible names within a record type are unique.
+
+            Comp_Or_Discr := First_Entity (Typ);
+            while Present (Comp_Or_Discr) loop
+               if Chars (Comp_Or_Discr) = Comp_Name then
+                  exit;
+               end if;
+
+               Comp_Or_Discr := Next_Entity (Comp_Or_Discr);
+            end loop;
+
+            --  Diagnose possible erroneous references
+
+            if Present (Comp_Or_Discr) then
+               if Ekind (Comp_Or_Discr) = E_Discriminant then
+                  Error_Attr
+                    ("attribute % may not modify record discriminants", Comp);
+
+               else pragma Assert (Ekind (Comp_Or_Discr) = E_Component);
+                  if Is_Duplicate_Component then
+                     Error_Msg_NE ("component & already updated", Comp, Comp);
+
+                  --  Mark this component as processed
+
+                  else
+                     if No (Comps) then
+                        Comps := New_Elmt_List;
+                     end if;
+
+                     Append_Elmt (Comp, Comps);
+                  end if;
+               end if;
+
+            --  The update aggregate mentions an entity that does not belong to
+            --  the record type.
+
+            else
+               Error_Msg_NE
+                 ("& is not a component of aggregate subtype", Comp, Comp);
+            end if;
+         end Check_Component_Reference;
+
+         --  Local variables
+
+         Assoc : Node_Id;
+         Comp  : Node_Id;
+
+      --  Start of processing for Update
+
+      begin
+         S14_Attribute;
+         Check_E1;
+
+         if not Is_Object_Reference (P) then
+            Error_Attr_P ("prefix of attribute % must denote an object");
+
+         elsif not Is_Array_Type (P_Type)
+           and then not Is_Record_Type (P_Type)
+         then
+            Error_Attr_P ("prefix of attribute % must be a record or array");
+
+         elsif Is_Immutably_Limited_Type (P_Type) then
+            Error_Attr ("prefix of attribute % cannot be limited", N);
+
+         elsif Nkind (E1) /= N_Aggregate then
+            Error_Attr ("attribute % requires component association list", N);
+         end if;
+
+         --  Inspect the update aggregate, looking at all the associations and
+         --  choices. Perform the following checks:
+
+         --    1) Legality of "others" in all cases
+         --    2) Component legality for records
+
+         --  The remaining checks are performed on the expanded attribute
+
+         Assoc := First (Component_Associations (E1));
+         while Present (Assoc) loop
+            Comp := First (Choices (Assoc));
+            while Present (Comp) loop
+               if Nkind (Comp) = N_Others_Choice then
+                  Error_Attr
+                    ("others choice not allowed in attribute %", Comp);
+
+               elsif Is_Record_Type (P_Type) then
+                  Check_Component_Reference (Comp, P_Type);
+               end if;
+
+               Next (Comp);
+            end loop;
+
+            Next (Assoc);
+         end loop;
+
+         --  The type of attribute Update is that of the prefix
+
+         Set_Etype (N, P_Type);
+      end Update;
+
       ---------
       -- Val --
       ---------
@@ -8210,6 +8368,15 @@ package body Sem_Attr is
          Static := True;
       end Unconstrained_Array;
 
+      --  Attribute Update is never static
+
+      ------------
+      -- Update --
+      ------------
+
+      when Attribute_Update =>
+         null;
+
       ---------------
       -- VADS_Size --
       ---------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 3e70492fb96..ec7f3b95d97 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7761,11 +7761,11 @@ package body Sem_Prag is
          -- Contract_Cases --
          --------------------
 
-         --  pragma Contract_Cases (POST_CASE_LIST);
+         --  pragma Contract_Cases (CONTRACT_CASE_LIST);
 
-         --  POST_CASE_LIST ::= POST_CASE {, POST_CASE}
+         --  CONTRACT_CASE_LIST ::= CONTRACT_CASE {, CONTRACT_CASE}
 
-         --  POST_CASE ::= CASE_GUARD => CONSEQUENCE
+         --  CONTRACT_CASE ::= CASE_GUARD => CONSEQUENCE
 
          --  CASE_GUARD ::= boolean_EXPRESSION | others
 
@@ -7786,11 +7786,22 @@ package body Sem_Prag is
                CTC  : Node_Id;
 
             begin
+               Check_Duplicate_Pragma (Subp);
                CTC := Spec_CTC_List (Contract (Subp));
                while Present (CTC) loop
                   if Chars (Pragma_Identifier (CTC)) = Pname then
-                     Error_Pragma ("pragma % already in use");
-                     return;
+                     Error_Msg_Name_1 := Pname;
+                     Error_Msg_Sloc := Sloc (CTC);
+
+                     if From_Aspect_Specification (CTC) then
+                        Error_Msg_NE
+                          ("aspect% for & previously given#", N, Subp);
+                     else
+                        Error_Msg_NE
+                          ("pragma% for & duplicates pragma#", N, Subp);
+                     end if;
+
+                     raise Pragma_Exit;
                   end if;
 
                   CTC := Next_Pragma (CTC);
@@ -7804,12 +7815,12 @@ package body Sem_Prag is
 
             --  Local variables
 
-            Case_Guard  : Node_Id;
-            Decl        : Node_Id;
-            Extra       : Node_Id;
-            Others_Seen : Boolean := False;
-            Post_Case   : Node_Id;
-            Subp_Decl   : Node_Id;
+            Case_Guard    : Node_Id;
+            Decl          : Node_Id;
+            Extra         : Node_Id;
+            Others_Seen   : Boolean := False;
+            Contract_Case : Node_Id;
+            Subp_Decl     : Node_Id;
 
          --  Start of processing for Contract_Cases
 
@@ -7866,30 +7877,32 @@ package body Sem_Prag is
                end if;
             end loop;
 
-            --  All post cases must appear as an aggregate
+            --  All contract cases must appear as an aggregate
 
             if Nkind (Expression (Arg1)) /= N_Aggregate then
                Error_Pragma ("wrong syntax for pragma %");
                return;
             end if;
 
-            --  Verify the legality of individual post cases
+            --  Verify the legality of individual contract cases
 
-            Post_Case := First (Component_Associations (Expression (Arg1)));
-            while Present (Post_Case) loop
-               if Nkind (Post_Case) /= N_Component_Association then
-                  Error_Pragma_Arg ("wrong syntax in post case", Post_Case);
+            Contract_Case :=
+              First (Component_Associations (Expression (Arg1)));
+            while Present (Contract_Case) loop
+               if Nkind (Contract_Case) /= N_Component_Association then
+                  Error_Pragma_Arg
+                    ("wrong syntax in contract case", Contract_Case);
                   return;
                end if;
 
-               Case_Guard := First (Choices (Post_Case));
+               Case_Guard := First (Choices (Contract_Case));
 
-               --  Each post case must have exactly on case guard
+               --  Each contract case must have exactly on case guard
 
                Extra := Next (Case_Guard);
                if Present (Extra) then
                   Error_Pragma_Arg
-                    ("post case may have only one case guard", Extra);
+                    ("contract case may have only one case guard", Extra);
                   return;
                end if;
 
@@ -7911,7 +7924,7 @@ package body Sem_Prag is
                   return;
                end if;
 
-               Next (Post_Case);
+               Next (Contract_Case);
             end loop;
 
             Chain_Contract_Cases (Subp_Decl);
@@ -11517,10 +11530,12 @@ package body Sem_Prag is
 
             Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
 
-            --  Transform pagma Loop_Invariant into an equivalent pragma Check.
+            --  Transform pragma Loop_Invariant into equivalent pragma Check
             --  Generate:
             --    pragma Check (Loop_Invaraint, Arg1);
 
+            --  Seems completely wrong to hijack pragma Check this way ???
+
             Rewrite (N,
               Make_Pragma (Loc,
                 Chars                        => Name_Check,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 05168b37a4a..cc269a1446c 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -901,6 +901,7 @@ package Snames is
    Name_Unconstrained_Array            : constant Name_Id := N + $;
    Name_Universal_Literal_String       : constant Name_Id := N + $; -- GNAT
    Name_Unrestricted_Access            : constant Name_Id := N + $; -- GNAT
+   Name_Update                         : constant Name_Id := N + $; -- GNAT
    Name_VADS_Size                      : constant Name_Id := N + $; -- GNAT
    Name_Val                            : constant Name_Id := N + $;
    Name_Valid                          : constant Name_Id := N + $;
@@ -1512,6 +1513,7 @@ package Snames is
       Attribute_Unconstrained_Array,
       Attribute_Universal_Literal_String,
       Attribute_Unrestricted_Access,
+      Attribute_Update,
       Attribute_VADS_Size,
       Attribute_Val,
       Attribute_Valid,
diff --git a/gcc/ada/urealp.ads b/gcc/ada/urealp.ads
index ca90ac4a0db..54fe8ffe14d 100644
--- a/gcc/ada/urealp.ads
+++ b/gcc/ada/urealp.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, 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- --
@@ -53,12 +53,13 @@ package Urealp is
    --    a real base (Nat, either zero, or in the range 2 .. 16)
    --    a sign flag (Boolean), set if negative
 
-   --  If the base is zero, then the absolute value of the Ureal is simply
-   --  numerator/denominator. If the base is non-zero, then the absolute
-   --  value is num / (rbase ** den).
+   --  Negative numbers are represented by the sign flag being True.
 
-   --  Negative numbers are represented by the sign of the numerator being
-   --  negative. The denominator is always positive.
+   --  If the base is zero, then the absolute value of the Ureal is simply
+   --  numerator/denominator, where denominator is positive. If the base is
+   --  non-zero, then the absolute value is numerator / (base ** denominator).
+   --  In that case, since base is positive, (base ** denominator) is also
+   --  positive, even when denominator is negative or null.
 
    --  A normalized Ureal value has base = 0, and numerator/denominator
    --  reduced to lowest terms, with zero itself being represented as 0/1.