[multiple changes]

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

	* einfo.adb (Set_Reverse_Storage_Order): Update assertion,
	flag is now valid for array types as well.

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* tracebak.c: Implement __gnat_backtrace for Win64 SEH.

2012-07-09  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Minor reformatting.

2012-07-09  Javier Miranda  <miranda@adacore.com>

	* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Handle as
	renaming_as_body renamings of predefined dispatching equality
	and unequality operators.

2012-07-09  Robert Dewar  <dewar@adacore.com>

	* rident.ads: Do not instantiate r-ident.ads, this is now an
	independent unit.

2012-07-09  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Write_DT): Avoid runtime crash of this debugging
	routine.
	* sem_disp.adb (Find_Dispatching_Time): Protect this routine
	against partially decorated entities.

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

	* sem_ch13.adb (Check_Size): Reject a size clause that specifies
	a value greater than Int'Last for a scalar type.

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

	* sem_ch9.adb (Allows_Lock_Free_Implementation): type must support
	atomic operation moved to the protected body case. No non-elementary
	out parameter moved to the protected declaration case. Functions have
	only one lock-free restriction.
	(Analyze_Protected_Type_Declaration): Issue a warning when
	Priority given with Lock_Free.

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

	* sem_dim.adb: Grammar of aspect Dimension fixed.

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

	* freeze.adb (Freeze_Record_Type): Code reorg in order to avoid
	pushing and popping the scope stack whenever a delayed aspect occurs.

2012-07-09  Gary Dismukes  <dismukes@adacore.com>

	* s-os_lib.ads: Remove pragma Elaborate_Body, as
	this is now unnecessary due to recently added pragma Preelaborate.

2012-07-09  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-mingw.adb (Set_Priority): Remove the code that was
	previously in place to reorder the ready queue when a task drops
	its priority due to the loss of inherited priority.

From-SVN: r189377

1 files changed, 110 insertions, 31 deletions

diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index a0e9d4c..3647ceb 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.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- --
@@ -239,6 +239,44 @@ package body Exp_Ch8 is
    ----------------------------------------------
 
    procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+      Id  : constant Entity_Id  := Defining_Entity (N);
+
+      function Build_Body_For_Renaming return Node_Id;
+      --  Build and return the body for the renaming declaration of an
+      --  equality or unequality operator.
+
+      function Build_Body_For_Renaming return Node_Id is
+         Body_Id : Entity_Id;
+         Decl    : Node_Id;
+
+      begin
+         Set_Alias (Id, Empty);
+         Set_Has_Completion (Id, False);
+         Rewrite (N,
+           Make_Subprogram_Declaration (Sloc (N),
+             Specification => Specification (N)));
+         Set_Has_Delayed_Freeze (Id);
+
+         Body_Id := Make_Defining_Identifier (Sloc (N), Chars (Id));
+         Set_Debug_Info_Needed (Body_Id);
+
+         Decl :=
+           Make_Subprogram_Body (Loc,
+             Specification              =>
+               Make_Function_Specification (Loc,
+                 Defining_Unit_Name       => Body_Id,
+                 Parameter_Specifications => Copy_Parameter_List (Id),
+                 Result_Definition        =>
+                   New_Occurrence_Of (Standard_Boolean, Loc)),
+             Declarations               => Empty_List,
+             Handled_Statement_Sequence => Empty);
+
+         return Decl;
+      end Build_Body_For_Renaming;
+
+      --  Local variable
+
       Nam : constant Node_Id := Name (N);
 
    begin
@@ -259,25 +297,26 @@ package body Exp_Ch8 is
          Force_Evaluation (Prefix (Nam));
       end if;
 
-      --  Check whether this is a renaming of a predefined equality on an
-      --  untagged record type (AI05-0123).
+      --  Handle cases where we build a body for a renamed equality
 
       if Is_Entity_Name (Nam)
-        and then Chars (Entity (Nam)) = Name_Op_Eq
+        and then (Chars (Entity (Nam)) = Name_Op_Ne
+                   or else Chars (Entity (Nam)) = Name_Op_Eq)
         and then Scope (Entity (Nam)) = Standard_Standard
-        and then Ada_Version >= Ada_2012
       then
          declare
-            Loc : constant Source_Ptr := Sloc (N);
-            Id  : constant Entity_Id  := Defining_Entity (N);
-            Typ : constant Entity_Id  := Etype (First_Formal (Id));
-
-            Decl    : Node_Id;
-            Body_Id : constant Entity_Id :=
-                        Make_Defining_Identifier (Sloc (N), Chars (Id));
+            Left  : constant Entity_Id := First_Formal (Id);
+            Right : constant Entity_Id := Next_Formal (Left);
+            Typ   : constant Entity_Id := Etype (Left);
+            Decl  : Node_Id;
 
          begin
-            if Is_Record_Type (Typ)
+            --  Check whether this is a renaming of a predefined equality on an
+            --  untagged record type (AI05-0123).
+
+            if Ada_Version >= Ada_2012
+              and then Chars (Entity (Nam)) = Name_Op_Eq
+              and then Is_Record_Type (Typ)
               and then not Is_Tagged_Type (Typ)
               and then not Is_Frozen (Typ)
             then
@@ -288,23 +327,7 @@ package body Exp_Ch8 is
                --  declaration, and the body is inserted at the end of the
                --  current declaration list to prevent premature freezing.
 
-               Set_Alias (Id, Empty);
-               Set_Has_Completion (Id, False);
-               Rewrite (N,
-                 Make_Subprogram_Declaration (Sloc (N),
-                   Specification => Specification (N)));
-               Set_Has_Delayed_Freeze (Id);
-
-               Decl := Make_Subprogram_Body (Loc,
-                         Specification              =>
-                           Make_Function_Specification (Loc,
-                             Defining_Unit_Name       => Body_Id,
-                             Parameter_Specifications =>
-                               Copy_Parameter_List (Id),
-                             Result_Definition        =>
-                               New_Occurrence_Of (Standard_Boolean, Loc)),
-                         Declarations               => Empty_List,
-                         Handled_Statement_Sequence => Empty);
+               Decl := Build_Body_For_Renaming;
 
                Set_Handled_Statement_Sequence (Decl,
                  Make_Handled_Sequence_Of_Statements (Loc,
@@ -322,7 +345,63 @@ package body Exp_Ch8 is
                             Bodies => Declarations (Decl))))));
 
                Append (Decl, List_Containing (N));
-               Set_Debug_Info_Needed (Body_Id);
+
+            --  Handle renamings of predefined dispatching equality operators.
+            --  When we analyze a renaming of the equality operator of a tagged
+            --  type, the predefined dispatching primitives are not available
+            --  (since they are added by the expander when the tagged type is
+            --  frozen) and hence they are left decorated as renamings of the
+            --  standard non-dispatching operators. Here we generate a body
+            --  for such renamings which invokes the predefined dispatching
+            --  equality operator.
+
+            --  Example:
+
+            --    type T is tagged null record;
+            --    function  Eq (X, Y : T1) return Boolean renames "=";
+            --    function Neq (X, Y : T1) return Boolean renames "/=";
+
+            elsif Is_Record_Type (Typ)
+              and then Is_Tagged_Type (Typ)
+              and then Is_Dispatching_Operation (Id)
+              and then not Is_Dispatching_Operation (Entity (Nam))
+            then
+               pragma Assert (not Is_Frozen (Typ));
+
+               Decl := Build_Body_For_Renaming;
+
+               --  Clean decoration of intrinsic subprogram
+
+               Set_Is_Intrinsic_Subprogram (Id, False);
+               Set_Convention (Id, Convention_Ada);
+
+               if Chars (Entity (Nam)) = Name_Op_Ne then
+                  Set_Handled_Statement_Sequence (Decl,
+                    Make_Handled_Sequence_Of_Statements (Loc,
+                      Statements => New_List (
+                        Make_Simple_Return_Statement (Loc,
+                          Expression =>
+                             Make_Op_Not (Loc,
+                               Make_Op_Eq (Loc,
+                                 Left_Opnd  =>
+                                   New_Reference_To (Left, Loc),
+                                 Right_Opnd =>
+                                   New_Reference_To (Right, Loc)))))));
+
+               else pragma Assert (Chars (Entity (Nam)) = Name_Op_Eq);
+                  Set_Handled_Statement_Sequence (Decl,
+                    Make_Handled_Sequence_Of_Statements (Loc,
+                      Statements => New_List (
+                        Make_Simple_Return_Statement (Loc,
+                          Expression =>
+                            Make_Op_Eq (Loc,
+                              Left_Opnd  =>
+                                New_Reference_To (Left, Loc),
+                              Right_Opnd =>
+                                New_Reference_To (Right, Loc))))));
+               end if;
+
+               Append (Decl, List_Containing (N));
             end if;
          end;
       end if;