exp_ch4.adb (Expand_N_Type_Conversion): Remove special processing for conversion of a Float_Type'Truncation to integer.

2007-04-06  Geert Bosch  <bosch@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Remove special processing
	for conversion of a Float_Type'Truncation to integer.

	* exp_attr.adb (Is_Inline_Floating_Point_Attribute): New function to
	check if a node is an attribute that can be handled directly by the
	back end.
	(Expand_N_Attribute_Reference): Suppress expansion of floating-point
	attributes that can be handled directly by the back end.
	(Expand_N_Attribute_Reference, case 'Access and 'Unchecked_Access):
	use new predicate Is_Access_Protected_Subprogram_Type.
	(Expand_N_Attribute_Reference, case 'Write): The reference is legal for
	and Unchecked_Union if it is generated as part of the default  Output
	procedure for a type with default discriminants.
	(Expand_N_Attribute_Reference): Avoid the expansion of dispatching calls
	if we are compiling under restriction No_Dispatching_Calls.
	(Constrained): Use Underlying_Type, in case the type is private without
	discriminants, but the full type has discriminants.
	(Expand_N_Attribute_Reference): Replace call to Get_Access_Level by
	call to Build_Get_Access_Level.
	(Expand_N_Attribute_Reference): The use of 'Address with class-wide
	interface objects requires a call to the run-time subprogram that
	returns the base address of the object.
	(Valid_Conversion): Improve error message on illegal attempt to store
	an anonymous access to subprogram value into a record component.

	* sem_res.adb (Resolve_Equality_Op): Detect ambiguity for "X'Access =
	null".
	(Simplify_Type_Conversion): New procedure that performs simplification
	of Int_Type (Float_Type'Truncation (X)).
	(Resolve_Type_Conversion): Call above procedure after resolving operand
	and before performing checks. This replaces the existing ineffective
	code in Exp_Ch4.
	(Set_String_Literal_Subtype): When creating the internal static lower
	bound subtype for a string literal, use a newly created copy of the
	subtree representing the lower bound.
	(Resolve_Call): Exclude build-in-place function calls from transient
	scope treatment. Update comments to describe this exception.
	(Resolve_Equality_Op): In case of dispatching call check violation of
	restriction No_Dispatching_Calls.
	(Resolve_Call): If the call returns an array, the context imposes the
	component type of the array, and the function has one non-defaulted
	parameter, rewrite the call as the indexing of a call with a single
	parameter, to handle an Ada 2005 syntactic ambiguity for calls written
	in prefix form.
	(Resolve_Actuals): If an actual is an allocator for an access parameter,
	the master of the created object is the innermost enclosing statement.
	(Remove_Conversions): For a binary operator, check if type of second
	formal is numeric, to check if an abstract interpretation is present
	in the case of exponentiation as well.

From-SVN: r123552

3 files changed, 735 insertions, 180 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 9d2bae1..79096e9 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -28,6 +28,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
+with Exp_Atag; use Exp_Atag;
 with Exp_Ch2;  use Exp_Ch2;
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Imgv; use Exp_Imgv;
@@ -160,6 +161,12 @@ package body Exp_Attr is
    --  Utility for array attributes, returns true on packed constrained
    --  arrays, and on access to same.
 
+   function Is_Inline_Floating_Point_Attribute (N : Node_Id) return Boolean;
+   --  Returns true iff the given node refers to an attribute call that
+   --  can be expanded directly by the back end and does not need front end
+   --  expansion. Typically used for rounding and truncation attributes that
+   --  appear directly inside a conversion to integer.
+
    ----------------------------------
    -- Compile_Stream_Body_In_Scope --
    ----------------------------------
@@ -497,7 +504,7 @@ package body Exp_Attr is
    -- Expand_Fpt_Attribute_RR --
    -----------------------------
 
-   --  The two arguments is converted to their root types to call the
+   --  The two arguments are converted to their root types to call the
    --  appropriate runtime function, with the actual call being built
    --  by Expand_Fpt_Attribute
 
@@ -665,7 +672,7 @@ package body Exp_Attr is
 
       when Attribute_Access =>
 
-         if Ekind (Btyp) = E_Access_Protected_Subprogram_Type then
+         if Is_Access_Protected_Subprogram_Type (Btyp) then
             Expand_Access_To_Protected_Op (N, Pref, Typ);
 
          elsif Ekind (Btyp) = E_General_Access_Type then
@@ -795,6 +802,23 @@ package body Exp_Attr is
 
                Analyze_And_Resolve (N, Addr);
             end;
+
+         --  Ada 2005 (AI-251): Class-wide interface objects are always
+         --  "displaced" to reference the tag associated with the interface
+         --  type. In order to obtain the real address of such objects we
+         --  generate a call to a run-time subprogram that returns the base
+         --  address of the object.
+
+         elsif Is_Class_Wide_Type (Etype (Pref))
+            and then Is_Interface (Etype (Pref))
+         then
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name => New_Reference_To (RTE (RE_Base_Address), Loc),
+                Parameter_Associations => New_List (
+                  Relocate_Node (N))));
+            Analyze (N);
+            return;
          end if;
 
          --  Deal with packed array reference, other cases are handled by gigi
@@ -829,6 +853,15 @@ package body Exp_Attr is
          --  operation _Alignment applied to X.
 
          elsif Is_Class_Wide_Type (Ptyp) then
+
+            --  No need to do anything else compiling under restriction
+            --  No_Dispatching_Calls. During the semantic analysis we
+            --  already notified such violation.
+
+            if Restriction_Active (No_Dispatching_Calls) then
+               return;
+            end if;
+
             New_Node :=
               Make_Function_Call (Loc,
                 Name => New_Reference_To
@@ -1327,8 +1360,13 @@ package body Exp_Attr is
                --  not accurate (the procedure formal case), has been
                --  handled above.
 
+               --  We use the Underlying_Type here (and below) in case the
+               --  type is private without discriminants, but the full type
+               --  has discriminants. This case is illegal, but we generate it
+               --  internally for passing to the Extra_Constrained parameter.
+
                else
-                  Res := Is_Constrained (Etype (Ent));
+                  Res := Is_Constrained (Underlying_Type (Etype (Ent)));
                end if;
 
                Rewrite (N,
@@ -1350,7 +1388,7 @@ package body Exp_Attr is
                      (Nkind (Pref) = N_Explicit_Dereference
                         and then
                           not Has_Constrained_Partial_View (Base_Type (Typ)))
-                    or else Is_Constrained (Typ)),
+                    or else Is_Constrained (Underlying_Type (Typ))),
                 Loc));
          end if;
 
@@ -2013,6 +2051,14 @@ package body Exp_Attr is
 
             elsif Is_Class_Wide_Type (P_Type) then
 
+               --  No need to do anything else compiling under restriction
+               --  No_Dispatching_Calls. During the semantic analysis we
+               --  already notified such violation.
+
+               if Restriction_Active (No_Dispatching_Calls) then
+                  return;
+               end if;
+
                declare
                   Rtyp : constant Entity_Id := Root_Type (P_Type);
                   Dnn  : Entity_Id;
@@ -2430,10 +2476,13 @@ package body Exp_Attr is
 
       --  Transforms 'Machine_Rounding into a call to the floating-point
       --  attribute function Machine_Rounding in Fat_xxx (where xxx is the root
-      --  type).
+      --  type). Expansion is avoided for cases the back end can handle
+      --  directly.
 
       when Attribute_Machine_Rounding =>
-         Expand_Fpt_Attribute_R (N);
+         if not Is_Inline_Floating_Point_Attribute (N) then
+            Expand_Fpt_Attribute_R (N);
+         end if;
 
       ------------------
       -- Machine_Size --
@@ -2707,6 +2756,15 @@ package body Exp_Attr is
             --  to the appropriate primitive Output function (RM 13.13.2(31)).
 
             elsif Is_Class_Wide_Type (P_Type) then
+
+               --  No need to do anything else compiling under restriction
+               --  No_Dispatching_Calls. During the semantic analysis we
+               --  already notified such violation.
+
+               if Restriction_Active (No_Dispatching_Calls) then
+                  return;
+               end if;
+
                Tag_Write : declare
                   Strm : constant Node_Id := First (Exprs);
                   Item : constant Node_Id := Next (Strm);
@@ -2730,21 +2788,18 @@ package body Exp_Attr is
                          Condition =>
                            Make_Op_Ne (Loc,
                              Left_Opnd  =>
-                               Make_Function_Call (Loc,
-                                 Name =>
-                                   New_Reference_To
-                                     (RTE (RE_Get_Access_Level), Loc),
-                                 Parameter_Associations =>
-                                   New_List (Make_Attribute_Reference (Loc,
-                                               Prefix         =>
-                                                 Relocate_Node (
-                                                   Duplicate_Subexpr (Item,
-                                                     Name_Req => True)),
-                                               Attribute_Name =>
-                                                  Name_Tag))),
+                               Build_Get_Access_Level (Loc,
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix         =>
+                                     Relocate_Node (
+                                       Duplicate_Subexpr (Item,
+                                         Name_Req => True)),
+                                   Attribute_Name => Name_Tag)),
+
                              Right_Opnd =>
-                               Make_Integer_Literal
-                                 (Loc, Type_Access_Level (P_Type))),
+                               Make_Integer_Literal (Loc,
+                                 Type_Access_Level (P_Type))),
+
                          Then_Statements =>
                            New_List (Make_Raise_Statement (Loc,
                                        New_Occurrence_Of (
@@ -2775,9 +2830,9 @@ package body Exp_Attr is
             elsif Is_Tagged_Type (U_Type) then
                Pname := Find_Prim_Op (U_Type, TSS_Stream_Output);
 
---              --  All other record type cases, including protected records.
---              --  The latter only arise for expander generated code for
---              --  handling shared passive partition access.
+            --  All other record type cases, including protected records.
+            --  The latter only arise for expander generated code for
+            --  handling shared passive partition access.
 
             else
                pragma Assert
@@ -3450,6 +3505,15 @@ package body Exp_Attr is
          --  X'Size into a call to the primitive operation _Size applied to X.
 
          elsif Is_Class_Wide_Type (Ptyp) then
+
+            --  No need to do anything else compiling under restriction
+            --  No_Dispatching_Calls. During the semantic analysis we
+            --  already notified such violation.
+
+            if Restriction_Active (No_Dispatching_Calls) then
+               return;
+            end if;
+
             New_Node :=
               Make_Function_Call (Loc,
                 Name => New_Reference_To
@@ -3912,10 +3976,13 @@ package body Exp_Attr is
       ----------------
 
       --  Transforms 'Truncation into a call to the floating-point attribute
-      --  function Truncation in Fat_xxx (where xxx is the root type)
+      --  function Truncation in Fat_xxx (where xxx is the root type).
+      --  Expansion is avoided for cases the back end can handle directly.
 
       when Attribute_Truncation =>
-         Expand_Fpt_Attribute_R (N);
+         if not Is_Inline_Floating_Point_Attribute (N) then
+            Expand_Fpt_Attribute_R (N);
+         end if;
 
       -----------------------
       -- Unbiased_Rounding --
@@ -3923,10 +3990,13 @@ package body Exp_Attr is
 
       --  Transforms 'Unbiased_Rounding into a call to the floating-point
       --  attribute function Unbiased_Rounding in Fat_xxx (where xxx is the
-      --  root type)
+      --  root type). Expansion is avoided for cases the back end can handle
+      --  directly.
 
       when Attribute_Unbiased_Rounding =>
-         Expand_Fpt_Attribute_R (N);
+         if not Is_Inline_Floating_Point_Attribute (N) then
+            Expand_Fpt_Attribute_R (N);
+         end if;
 
       ----------------------
       -- Unchecked_Access --
@@ -3999,7 +4069,7 @@ package body Exp_Attr is
 
       when Attribute_Unrestricted_Access =>
 
-         if Ekind (Btyp) = E_Access_Protected_Subprogram_Type then
+         if Is_Access_Protected_Subprogram_Type (Btyp) then
             Expand_Access_To_Protected_Op (N, Pref, Typ);
 
          --  Ada 2005 (AI-251): If the designated type is an interface, then
@@ -4184,7 +4254,7 @@ package body Exp_Attr is
                   --  to call the special routine Unaligned_Valid, which makes
                   --  the needed copy, being careful not to load the value into
                   --  any floating-point register. The argument in this case is
-                  --  obj'Address (see Unchecked_Valid routine in Fat_Gen).
+                  --  obj'Address (see Unaligned_Valid routine in Fat_Gen).
 
                   if Is_Possibly_Unaligned_Object (Pref) then
                      Set_Attribute_Name (N, Name_Unaligned_Valid);
@@ -4667,9 +4737,14 @@ package body Exp_Attr is
 
                --  Ada 2005 (AI-216): Program_Error is raised when executing
                --  the default implementation of the Write attribute of an
-               --  Unchecked_Union type.
+               --  Unchecked_Union type. However, if the 'Write reference is
+               --  within the generated Output stream procedure, Write outputs
+               --  the components, and the default values of the discriminant
+               --  are streamed by the Output procedure itself.
 
-               if Is_Unchecked_Union (Base_Type (U_Type)) then
+               if Is_Unchecked_Union (Base_Type (U_Type))
+                 and not Is_TSS (Current_Scope, TSS_Stream_Output)
+               then
                   Insert_Action (N,
                     Make_Raise_Program_Error (Loc,
                       Reason => PE_Unchecked_Union_Restriction));
@@ -5038,4 +5113,24 @@ package body Exp_Attr is
         and then Present (Packed_Array_Type (Arr));
    end Is_Constrained_Packed_Array;
 
+   ----------------------------------------
+   -- Is_Inline_Floating_Point_Attribute --
+   ----------------------------------------
+
+   function Is_Inline_Floating_Point_Attribute (N : Node_Id) return Boolean is
+      Id : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
+
+   begin
+      if Nkind (Parent (N)) /= N_Type_Conversion
+        or else not Is_Integer_Type (Etype (Parent (N)))
+      then
+         return False;
+      end if;
+
+      --  Should also support 'Machine_Rounding and 'Unbiased_Rounding, but
+      --  required back end support has not been implemented yet ???
+
+      return Id = Attribute_Truncation;
+   end Is_Inline_Floating_Point_Attribute;
+
 end Exp_Attr;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a65809f..d508c34 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -30,6 +30,7 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Aggr; use Exp_Aggr;
+with Exp_Atag; use Exp_Atag;
 with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
@@ -46,6 +47,8 @@ with Inline;   use Inline;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
+with Restrict; use Restrict;
+with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Cat;  use Sem_Cat;
@@ -481,37 +484,47 @@ package body Exp_Ch4 is
          --  type, generate an accessibility check to verify that the level of
          --  the type of the created object is not deeper than the level of the
          --  access type. If the type of the qualified expression is class-
-         --  wide, then always generate the check. Otherwise, only generate the
-         --  check if the level of the qualified expression type is statically
-         --  deeper than the access type. Although the static accessibility
-         --  will generally have been performed as a legality check, it won't
-         --  have been done in cases where the allocator appears in generic
-         --  body, so a run-time check is needed in general.
+         --  wide, then always generate the check (except in the case where it
+         --  is known to be unnecessary, see comment below). Otherwise, only
+         --  generate the check if the level of the qualified expression type
+         --  is statically deeper than the access type. Although the static
+         --  accessibility will generally have been performed as a legality
+         --  check, it won't have been done in cases where the allocator
+         --  appears in generic body, so a run-time check is needed in general.
+         --  One special case is when the access type is declared in the same
+         --  scope as the class-wide allocator, in which case the check can
+         --  never fail, so it need not be generated. As an open issue, there
+         --  seem to be cases where the static level associated with the
+         --  class-wide object's underlying type is not sufficient to perform
+         --  the proper accessibility check, such as for allocators in nested
+         --  subprograms or accept statements initialized by class-wide formals
+         --  when the actual originates outside at a deeper static level. The
+         --  nested subprogram case might require passing accessibility levels
+         --  along with class-wide parameters, and the task case seems to be
+         --  an actual gap in the language rules that needs to be fixed by the
+         --  ARG. ???
 
          if Ada_Version >= Ada_05
            and then Is_Class_Wide_Type (DesigT)
            and then not Scope_Suppress (Accessibility_Check)
            and then
-             (Is_Class_Wide_Type (Etype (Exp))
-                or else
-              Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT))
+             (Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT)
+               or else
+                 (Is_Class_Wide_Type (Etype (Exp))
+                   and then Scope (PtrT) /= Current_Scope))
          then
             Insert_Action (N,
                Make_Raise_Program_Error (Loc,
                  Condition =>
                    Make_Op_Gt (Loc,
                      Left_Opnd  =>
-                       Make_Function_Call (Loc,
-                         Name =>
-                           New_Reference_To (RTE (RE_Get_Access_Level), Loc),
-                         Parameter_Associations =>
-                           New_List (Make_Attribute_Reference (Loc,
-                                       Prefix         =>
-                                          New_Reference_To (Temp, Loc),
-                                       Attribute_Name =>
-                                          Name_Tag))),
+                       Build_Get_Access_Level (Loc,
+                         Make_Attribute_Reference (Loc,
+                           Prefix => New_Reference_To (Temp, Loc),
+                           Attribute_Name => Name_Tag)),
                      Right_Opnd =>
-                       Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
+                       Make_Integer_Literal (Loc,
+                         Type_Access_Level (PtrT))),
                  Reason => PE_Accessibility_Check_Failed));
          end if;
 
@@ -2489,6 +2502,72 @@ package body Exp_Ch4 is
       Temp  : Entity_Id;
       Node  : Node_Id;
 
+      function Is_Local_Access_Discriminant (N : Node_Id) return Boolean;
+      --  If the allocator is for an access discriminant of a stack-allocated
+      --  object, the discriminant can be allocated locally as well, to ensure
+      --  that its lifetime does not exceed that of the enclosing object.
+      --  This is an optimization mandated / suggested by Ada 2005 AI-162.
+
+      ----------------------------------
+      -- Is_Local_Access_Discriminant --
+      ----------------------------------
+
+      function Is_Local_Access_Discriminant (N : Node_Id) return Boolean is
+         Decl : Node_Id;
+         Temp : Entity_Id;
+
+      begin
+         if Nkind (Parent (N)) = N_Index_Or_Discriminant_Constraint
+           and then not Is_Coextension (N)
+           and then not Is_Record_Type (Current_Scope)
+         then
+            Temp :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_Internal_Name ('T'));
+
+            Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Aliased_Present     => True,
+                Object_Definition   => New_Occurrence_Of (Etyp, Loc));
+
+            if Nkind (Expression (N)) = N_Qualified_Expression then
+               Set_Expression (Decl, Expression (Expression (N)));
+            end if;
+
+            declare
+               Nod : Node_Id;
+
+            begin
+               Nod := Parent (N);
+               while Present (Nod) loop
+                  exit when
+                      Nkind (Nod) in N_Statement_Other_Than_Procedure_Call
+                    or else Nkind (Nod) = N_Procedure_Call_Statement
+                    or else Nkind (Nod) in N_Declaration;
+                  Nod := Parent (Nod);
+               end loop;
+
+               Insert_Before (Nod, Decl);
+               Analyze (Decl);
+            end;
+
+            Rewrite (N,
+              Make_Attribute_Reference (Loc,
+                Prefix => New_Occurrence_Of (Temp, Loc),
+                Attribute_Name => Name_Unrestricted_Access));
+
+            Analyze_And_Resolve (N, PtrT);
+
+            return True;
+
+         else
+            return False;
+         end if;
+      end Is_Local_Access_Discriminant;
+
+   --  Start of processing for Expand_N_Allocator
+
    begin
       --  RM E.2.3(22). We enforce that the expected type of an allocator
       --  shall not be a remote access-to-class-wide-limited-private type
@@ -2581,6 +2660,14 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Same if the allocator is an access discriminant for a local object:
+      --  instead of an allocator we create a local value and constrain the
+      --  the enclosing object with the corresponding access attribute.
+
+      if Is_Local_Access_Discriminant (N) then
+         return;
+      end if;
+
       --  Handle case of qualified expression (other than optimization above)
 
       if Nkind (Expression (N)) = N_Qualified_Expression then
@@ -2721,6 +2808,7 @@ package body Exp_Ch4 is
                      --  The designated type was an incomplete type, and the
                      --  access type did not get expanded. Salvage it now.
 
+                     pragma Assert (Present (Parent (Base_Type (PtrT))));
                      Expand_N_Full_Type_Declaration
                        (Parent (Base_Type (PtrT)));
                   end if;
@@ -2895,11 +2983,26 @@ package body Exp_Ch4 is
 
                if Controlled_Type (T) then
                   Flist := Get_Allocator_Final_List (N, Base_Type (T), PtrT);
-                  if Ekind (PtrT) = E_Anonymous_Access_Type then
+
+                  --  Anonymous access types created for access parameters
+                  --  are attached to an explicitly constructed controller,
+                  --  which ensures that they can be finalized properly, even
+                  --  if their deallocation might not happen. The list
+                  --  associated with the controller is doubly-linked. For
+                  --  other anonymous access types, the object may end up
+                  --  on the global final list which is singly-linked.
+                  --  Work needed for access discriminants in Ada 2005 ???
+
+                  if Ekind (PtrT) = E_Anonymous_Access_Type
+                      and then
+                        Nkind (Associated_Node_For_Itype (PtrT))
+                          not in N_Subprogram_Specification
+                  then
                      Attach_Level := Uint_1;
                   else
                      Attach_Level := Uint_2;
                   end if;
+
                   Insert_Actions (N,
                     Make_Init_Call (
                       Ref          => New_Copy_Tree (Arg1),
@@ -4571,6 +4674,14 @@ package body Exp_Ch4 is
 
          if Is_Tagged_Type (Typl) then
 
+            --  No need to do anything else compiling under restriction
+            --  No_Dispatching_Calls. During the semantic analysis we
+            --  already notified such violation.
+
+            if Restriction_Active (No_Dispatching_Calls) then
+               return;
+            end if;
+
             --  If this is derived from an untagged private type completed
             --  with a tagged type, it does not have a full view, so we
             --  use the primitive operations of the private type.
@@ -6420,6 +6531,18 @@ package body Exp_Ch4 is
         and then (not Is_Entity_Name (Pfx)
                    or else not Index_Checks_Suppressed (Entity (Pfx)))
         and then Nkind (Discrete_Range (N)) /= N_Subtype_Indication
+
+         --  Do not enable range check to nodes associated with the frontend
+         --  expansion of the dispatch table. We first check if Ada.Tags is
+         --  already loaded to avoid the addition of an undesired dependence
+         --  on such run-time unit.
+
+        and then not
+          (RTU_Loaded (Ada_Tags)
+            and then Nkind (Prefix (N)) = N_Selected_Component
+            and then Present (Entity (Selector_Name (Prefix (N))))
+            and then Entity (Selector_Name (Prefix (N))) =
+                                         RTE_Record_Component (RE_Prims_Ptr))
       then
          Enable_Range_Check (Discrete_Range (N));
       end if;
@@ -6431,7 +6554,7 @@ package body Exp_Ch4 is
       --       situation correctly in the assignment statement expansion).
 
       --    2. Prefix of indexed component (the slide is optimized away
-      --       in this case, see the start of Expand_N_Slice.
+      --       in this case, see the start of Expand_N_Slice.)
 
       --    3. Object renaming declaration, since we want the name of
       --       the slice, not the value.
@@ -6906,7 +7029,7 @@ package body Exp_Ch4 is
             return;
          end if;
 
-         --  Oherwise, proceed with processing tagged conversion
+         --  Otherwise, proceed with processing tagged conversion
 
          declare
             Actual_Operand_Type : Entity_Id;
@@ -7072,32 +7195,16 @@ package body Exp_Ch4 is
             or else
           (Is_Fixed_Point_Type (Target_Type) and then Conversion_OK (N)))
       then
-         --  Special processing required if the conversion is the expression
-         --  of a Truncation attribute reference. In this case we replace:
-
-         --     ityp (ftyp'Truncation (x))
-
-         --  by
-
-         --     ityp (x)
-
-         --  with the Float_Truncate flag set. This is clearly more efficient
-
-         if Nkind (Operand) = N_Attribute_Reference
-           and then Attribute_Name (Operand) = Name_Truncation
-         then
-            Rewrite (Operand,
-              Relocate_Node (First (Expressions (Operand))));
-            Set_Float_Truncate (N, True);
-         end if;
-
          --  One more check here, gcc is still not able to do conversions of
          --  this type with proper overflow checking, and so gigi is doing an
          --  approximation of what is required by doing floating-point compares
          --  with the end-point. But that can lose precision in some cases, and
          --  give a wrong result. Converting the operand to Universal_Real is
          --  helpful, but still does not catch all cases with 64-bit integers
-         --  on targets with only 64-bit floats ???
+         --  on targets with only 64-bit floats
+
+         --  The above comment seems obsoleted by Apply_Float_Conversion_Check
+         --  Can this code be removed ???
 
          if Do_Range_Check (Operand) then
             Rewrite (Operand,
@@ -8358,6 +8465,11 @@ package body Exp_Ch4 is
    --  is usually implemented by looking in the ancestor tables contained in
    --  the dispatch table pointed by Left_Expr.Tag for Typ'Tag
 
+   --  Ada 2005 (AI-251): If it is a class-wide interface type we use the RT
+   --  function IW_Membership which is usually implemented by looking in the
+   --  table of abstract interface types plus the ancestor table contained in
+   --  the dispatch table pointed by Left_Expr.Tag for Typ'Tag
+
    function Tagged_Membership (N : Node_Id) return Node_Id is
       Left  : constant Node_Id    := Left_Opnd  (N);
       Right : constant Node_Id    := Right_Opnd (N);
@@ -8383,11 +8495,44 @@ package body Exp_Ch4 is
 
       if Is_Class_Wide_Type (Right_Type) then
 
+         --  No need to issue a run-time check if we statically know that the
+         --  result of this membership test is always true. For example,
+         --  considering the following declarations:
+
+         --    type Iface is interface;
+         --    type T     is tagged null record;
+         --    type DT    is new T and Iface with null record;
+
+         --    Obj1 : T;
+         --    Obj2 : DT;
+
+         --  These membership tests are always true:
+
+         --    Obj1 in T'Class
+         --    Obj2 in T'Class;
+         --    Obj2 in Iface'Class;
+
+         --  We do not need to handle cases where the membership is illegal.
+         --  For example:
+
+         --    Obj1 in DT'Class;     --  Compile time error
+         --    Obj1 in Iface'Class;  --  Compile time error
+
+         if not Is_Class_Wide_Type (Left_Type)
+           and then (Is_Parent (Etype (Right_Type), Left_Type)
+                       or else (Is_Interface (Etype (Right_Type))
+                                 and then Interface_Present_In_Ancestor
+                                           (Typ   => Left_Type,
+                                            Iface => Etype (Right_Type))))
+         then
+            return New_Reference_To (Standard_True, Loc);
+         end if;
+
          --  Ada 2005 (AI-251): Class-wide applied to interfaces
 
          if Is_Interface (Etype (Class_Wide_Type (Right_Type)))
 
-            --   Give support to: "Iface_CW_Typ in Typ'Class"
+            --   Support to: "Iface_CW_Typ in Typ'Class"
 
            or else Is_Interface (Left_Type)
          then
@@ -8415,23 +8560,31 @@ package body Exp_Ch4 is
 
          else
             return
-              Make_Function_Call (Loc,
-                 Name => New_Occurrence_Of (RTE (RE_CW_Membership), Loc),
-                 Parameter_Associations => New_List (
-                   Obj_Tag,
+              Build_CW_Membership (Loc,
+                Obj_Tag_Node => Obj_Tag,
+                Typ_Tag_Node =>
                    New_Reference_To (
                      Node (First_Elmt
                             (Access_Disp_Table (Root_Type (Right_Type)))),
-                     Loc)));
+                     Loc));
          end if;
 
+      --  Right_Type is not a class-wide type
+
       else
-         return
-           Make_Op_Eq (Loc,
-             Left_Opnd  => Obj_Tag,
-             Right_Opnd =>
-               New_Reference_To
-                 (Node (First_Elmt (Access_Disp_Table (Right_Type))), Loc));
+         --  No need to check the tag of the object if Right_Typ is abstract
+
+         if Is_Abstract_Type (Right_Type) then
+            return New_Reference_To (Standard_False, Loc);
+
+         else
+            return
+              Make_Op_Eq (Loc,
+                Left_Opnd  => Obj_Tag,
+                Right_Opnd =>
+                  New_Reference_To
+                    (Node (First_Elmt (Access_Disp_Table (Right_Type))), Loc));
+         end if;
       end if;
    end Tagged_Membership;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ee263fe..8a0f531 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -32,6 +32,7 @@ with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Expander; use Expander;
 with Exp_Disp; use Exp_Disp;
+with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
@@ -66,7 +67,6 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Urealp;   use Urealp;
@@ -215,6 +215,11 @@ package body Sem_Res is
    procedure Set_Slice_Subtype (N : Node_Id);
    --  Build subtype of array type, with the range specified by the slice
 
+   procedure Simplify_Type_Conversion (N : Node_Id);
+   --  Called after N has been resolved and evaluated, but before range checks
+   --  have been applied. Currently simplifies a combination of floating-point
+   --  to integer conversion and Truncation attribute.
+
    function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
    --  A universal_fixed expression in an universal context is unambiguous
    --  if there is only one applicable fixed point type. Determining whether
@@ -821,15 +826,9 @@ package body Sem_Res is
    --  Start of processing for Check_Initialization_Call
 
    begin
-      --  Nothing to do if functions do not use the secondary stack for
-      --  returns (i.e. they use a depressed stack pointer instead).
-
-      if Functions_Return_By_DSP_On_Target then
-         return;
+      --  Establish a transient scope if the type needs it
 
-      --  Otherwise establish a transient scope if the type needs it
-
-      elsif Uses_SS (Typ) then
+      if Uses_SS (Typ) then
          Establish_Transient_Scope (First_Actual (N), Sec_Stack => True);
       end if;
    end Check_Initialization_Call;
@@ -1835,24 +1834,29 @@ package body Sem_Res is
                               N, It.Nam);
                         end if;
 
-                        Error_Msg_N
-                          ("\\possible interpretation#!", N);
                         Ambiguous := True;
+
+                        if Nkind (Parent (Seen)) = N_Full_Type_Declaration then
+                           Error_Msg_N
+                             ("\\possible interpretation (inherited)#!", N);
+                        else
+                           Error_Msg_N ("\\possible interpretation#!", N);
+                        end if;
                      end if;
 
                      Error_Msg_Sloc := Sloc (It.Nam);
 
                      --  By default, the error message refers to the candidate
-                     --  interpretation. But if it is a  predefined operator,
-                     --  it is implicitly declared at the declaration of
-                     --  the type of the operand. Recover the sloc of that
-                     --  declaration for the error message.
+                     --  interpretation. But if it is a predefined operator, it
+                     --  is implicitly declared at the declaration of the type
+                     --  of the operand. Recover the sloc of that declaration
+                     --  for the error message.
 
                      if Nkind (N) in N_Op
                        and then Scope (It.Nam) = Standard_Standard
                        and then not Is_Overloaded (Right_Opnd (N))
-                       and then  Scope (Base_Type (Etype (Right_Opnd (N))))
-                            /= Standard_Standard
+                       and then Scope (Base_Type (Etype (Right_Opnd (N)))) /=
+                                                             Standard_Standard
                      then
                         Err_Type := First_Subtype (Etype (Right_Opnd (N)));
 
@@ -1865,8 +1869,8 @@ package body Sem_Res is
                      elsif Nkind (N) in N_Binary_Op
                        and then Scope (It.Nam) = Standard_Standard
                        and then not Is_Overloaded (Left_Opnd (N))
-                       and then Scope (Base_Type (Etype (Left_Opnd (N))))
-                            /= Standard_Standard
+                       and then Scope (Base_Type (Etype (Left_Opnd (N)))) /=
+                                                             Standard_Standard
                      then
                         Err_Type := First_Subtype (Etype (Left_Opnd (N)));
 
@@ -1888,7 +1892,6 @@ package body Sem_Res is
                         Err_Type := It.Nam;
                         Error_Msg_Sloc :=
                           Sloc (Associated_Node_For_Itype (Err_Type));
-
                      else
                         Err_Type := Empty;
                      end if;
@@ -1912,11 +1915,11 @@ package body Sem_Res is
                   end if;
                end if;
 
-               --  We have a matching interpretation, Expr_Type is the
-               --  type from this interpretation, and Seen is the entity.
+               --  We have a matching interpretation, Expr_Type is the type
+               --  from this interpretation, and Seen is the entity.
 
-               --  For an operator, just set the entity name. The type will
-               --  be set by the specific operator resolution routine.
+               --  For an operator, just set the entity name. The type will be
+               --  set by the specific operator resolution routine.
 
                if Nkind (N) in N_Op then
                   Set_Entity (N, Seen);
@@ -1926,9 +1929,9 @@ package body Sem_Res is
                   Set_Etype (N, Expr_Type);
 
                --  For an explicit dereference, attribute reference, range,
-               --  short-circuit form (which is not an operator node),
-               --  or a call with a name that is an explicit dereference,
-               --  there is nothing to be done at this point.
+               --  short-circuit form (which is not an operator node), or call
+               --  with a name that is an explicit dereference, there is
+               --  nothing to be done at this point.
 
                elsif     Nkind (N) = N_Explicit_Dereference
                  or else Nkind (N) = N_Attribute_Reference
@@ -1942,8 +1945,8 @@ package body Sem_Res is
                then
                   null;
 
-               --  For procedure or function calls, set the type of the
-               --  name, and also the entity pointer for the prefix
+               --  For procedure or function calls, set the type of the name,
+               --  and also the entity pointer for the prefix
 
                elsif (Nkind (N) = N_Procedure_Call_Statement
                        or else Nkind (N) = N_Function_Call)
@@ -1985,11 +1988,10 @@ package body Sem_Res is
       if not Found then
          if Typ /= Any_Type then
 
-            --  If type we are looking for is Void, then this is the
-            --  procedure call case, and the error is simply that what
-            --  we gave is not a procedure name (we think of procedure
-            --  calls as expressions with types internally, but the user
-            --  doesn't think of them this way!)
+            --  If type we are looking for is Void, then this is the procedure
+            --  call case, and the error is simply that what we gave is not a
+            --  procedure name (we think of procedure calls as expressions with
+            --  types internally, but the user doesn't think of them this way!)
 
             if Typ = Standard_Void_Type then
 
@@ -2003,8 +2005,8 @@ package body Sem_Res is
                     ("cannot use function & in a procedure call",
                      Name (N), Entity (Name (N)));
 
-               --  Otherwise give general message (not clear what cases
-               --  this covers, but no harm in providing for them!)
+               --  Otherwise give general message (not clear what cases this
+               --  covers, but no harm in providing for them!)
 
                else
                   Error_Msg_N ("expect procedure name in procedure call", N);
@@ -2014,11 +2016,11 @@ package body Sem_Res is
 
             --  Otherwise we do have a subexpression with the wrong type
 
-            --  Check for the case of an allocator which uses an access
-            --  type instead of the designated type. This is a common
-            --  error and we specialize the message, posting an error
-            --  on the operand of the allocator, complaining that we
-            --  expected the designated type of the allocator.
+            --  Check for the case of an allocator which uses an access type
+            --  instead of the designated type. This is a common error and we
+            --  specialize the message, posting an error on the operand of the
+            --  allocator, complaining that we expected the designated type of
+            --  the allocator.
 
             elsif Nkind (N) = N_Allocator
               and then Ekind (Typ) in Access_Kind
@@ -2028,8 +2030,8 @@ package body Sem_Res is
                Wrong_Type (Expression (N), Designated_Type (Typ));
                Found := True;
 
-            --  Check for view mismatch on Null in instances, for
-            --  which the view-swapping mechanism has no identifier.
+            --  Check for view mismatch on Null in instances, for which the
+            --  view-swapping mechanism has no identifier.
 
             elsif (In_Instance or else In_Inlined_Body)
               and then (Nkind (N) = N_Null)
@@ -2087,10 +2089,10 @@ package body Sem_Res is
                         Elmt := First (Component_Associations (Aggr));
                         while Present (Elmt) loop
 
-                           --  Nothing to check is this is a default-
-                           --  initialized component. The box will be
-                           --  be replaced by the appropriate call during
-                           --  late expansion.
+                           --  If this is a default-initialized component, then
+                           --  there is nothing to check. The box will be
+                           --  replaced by the appropriate call during late
+                           --  expansion.
 
                            if not Box_Present (Elmt) then
                               Check_Elmt (Expression (Elmt));
@@ -2293,15 +2295,15 @@ package body Sem_Res is
             when N_Identifier
                              => Resolve_Entity_Name              (N, Ctx_Type);
 
-            when N_Membership_Test
-                             => Resolve_Membership_Op            (N, Ctx_Type);
-
             when N_Indexed_Component
                              => Resolve_Indexed_Component        (N, Ctx_Type);
 
             when N_Integer_Literal
                              => Resolve_Integer_Literal          (N, Ctx_Type);
 
+            when N_Membership_Test
+                             => Resolve_Membership_Op            (N, Ctx_Type);
+
             when N_Null      => Resolve_Null                     (N, Ctx_Type);
 
             when N_Op_And | N_Op_Or | N_Op_Xor
@@ -2773,6 +2775,16 @@ package body Sem_Res is
                           Directly_Designated_Type (Etype (A)));
                         Set_Etype (A, New_Itype);
                      end if;
+
+                     --  Ada 2005, AI-162:If the actual is an allocator, the
+                     --  innermost enclosing statement is the master of the
+                     --  created object.
+
+                     if Is_Controlled (DDT)
+                       or else Has_Task (DDT)
+                     then
+                        Establish_Transient_Scope (A, False);
+                     end if;
                   end;
                end if;
 
@@ -2959,8 +2971,28 @@ package body Sem_Res is
             --  Check that subprograms don't have improper controlling
             --  arguments (RM 3.9.2 (9))
 
+            --  A primitive operation may have an access parameter of an
+            --  incomplete tagged type, but a dispatching call is illegal
+            --  if the type is still incomplete.
+
             if Is_Controlling_Formal (F) then
                Set_Is_Controlling_Actual (A);
+
+               if Ekind (Etype (F)) = E_Anonymous_Access_Type then
+                  declare
+                     Desig : constant Entity_Id := Designated_Type (Etype (F));
+                  begin
+                     if Ekind (Desig) = E_Incomplete_Type
+                       and then No (Full_View (Desig))
+                       and then No (Non_Limited_View (Desig))
+                     then
+                        Error_Msg_NE
+                          ("premature use of incomplete type& " &
+                           "in dispatching call", A, Desig);
+                     end if;
+                  end;
+               end if;
+
             elsif Nkind (A) = N_Explicit_Dereference then
                Validate_Remote_Access_To_Class_Wide_Type (A);
             end if;
@@ -3070,7 +3102,7 @@ package body Sem_Res is
          Set_Etype (N, Base_Type (Typ));
       end if;
 
-      if Is_Abstract (Typ) then
+      if Is_Abstract_Type (Typ) then
          Error_Msg_N ("type of allocator cannot be abstract",  N);
       end if;
 
@@ -3924,7 +3956,7 @@ package body Sem_Res is
       --  when the type of the component is an access to the array type. In
       --  this case the call is truly ambiguous.
 
-      elsif Needs_No_Actuals (Nam)
+      elsif (Needs_No_Actuals (Nam) or else Needs_One_Actual (Nam))
         and then
           ((Is_Array_Type (Etype (Nam))
                    and then Covers (Typ, Component_Type (Etype (Nam))))
@@ -3950,12 +3982,33 @@ package body Sem_Res is
                Set_Entity (Subp, Nam);
 
                if Component_Type (Ret_Type) /= Any_Type then
-                  Index_Node :=
-                    Make_Indexed_Component (Loc,
-                      Prefix =>
-                        Make_Function_Call (Loc,
-                          Name => New_Subp),
-                      Expressions => Parameter_Associations (N));
+                  if Needs_No_Actuals (Nam) then
+
+                     --  Indexed call to a parameterless function
+
+                     Index_Node :=
+                       Make_Indexed_Component (Loc,
+                         Prefix =>
+                           Make_Function_Call (Loc,
+                             Name => New_Subp),
+                         Expressions => Parameter_Associations (N));
+                  else
+                     --  An Ada 2005 prefixed call to a primitive operation
+                     --  whose first parameter is the prefix. This prefix was
+                     --  prepended to the parameter list, which is actually a
+                     --  list of indices. Remove the prefix in order to build
+                     --  the proper indexed component.
+
+                     Index_Node :=
+                        Make_Indexed_Component (Loc,
+                          Prefix =>
+                            Make_Function_Call (Loc,
+                               Name => New_Subp,
+                               Parameter_Associations =>
+                                 New_List
+                                   (Remove_Head (Parameter_Associations (N)))),
+                           Expressions => Parameter_Associations (N));
+                  end if;
 
                   --  Since we are correcting a node classification error made
                   --  by the parser, we call Replace rather than Rewrite.
@@ -4110,12 +4163,16 @@ package body Sem_Res is
 
       --  Create a transient scope if the resulting type requires it
 
-      --  There are 3 notable exceptions: in init procs, the transient scope
+      --  There are 4 notable exceptions: in init procs, the transient scope
       --  overhead is not needed and even incorrect due to the actual expansion
-      --  of adjust calls; the second case is enumeration literal pseudo calls,
-      --  the other case is intrinsic subprograms (Unchecked_Conversion and
+      --  of adjust calls; the second case is enumeration literal pseudo calls;
+      --  the third case is intrinsic subprograms (Unchecked_Conversion and
       --  source information functions) that do not use the secondary stack
-      --  even though the return type is unconstrained.
+      --  even though the return type is unconstrained; the fourth case is a
+      --  call to a build-in-place function, since such functions may allocate
+      --  their result directly in a target object, and cases where the result
+      --  does get allocated in the secondary stack are checked for within the
+      --  specialized Exp_Ch6 procedures for expanding build-in-place calls.
 
       --  If this is an initialization call for a type whose initialization
       --  uses the secondary stack, we also need to create a transient scope
@@ -4136,12 +4193,12 @@ package body Sem_Res is
       elsif Expander_Active
         and then Is_Type (Etype (Nam))
         and then Requires_Transient_Scope (Etype (Nam))
+        and then not Is_Build_In_Place_Function (Nam)
         and then Ekind (Nam) /= E_Enumeration_Literal
         and then not Within_Init_Proc
         and then not Is_Intrinsic_Subprogram (Nam)
       then
-         Establish_Transient_Scope
-           (N, Sec_Stack => not Functions_Return_By_DSP_On_Target);
+         Establish_Transient_Scope (N, Sec_Stack => True);
 
          --  If the call appears within the bounds of a loop, it will
          --  be rewritten and reanalyzed, nothing left to do here.
@@ -4213,7 +4270,8 @@ package body Sem_Res is
       then
          Check_Dispatching_Call (N);
 
-      elsif Is_Abstract (Nam)
+      elsif Ekind (Nam) /= E_Subprogram_Type
+        and then Is_Abstract_Subprogram (Nam)
         and then not In_Instance
       then
          Error_Msg_NE ("cannot call abstract subprogram &!", N, Nam);
@@ -4978,8 +5036,7 @@ package body Sem_Res is
       elsif Expander_Active
         and then Requires_Transient_Scope (Etype (Nam))
       then
-         Establish_Transient_Scope (N,
-           Sec_Stack => not Functions_Return_By_DSP_On_Target);
+         Establish_Transient_Scope (N, Sec_Stack => True);
       end if;
    end Resolve_Entry_Call;
 
@@ -5073,6 +5130,7 @@ package body Sem_Res is
 
          elsif T = Any_Access
            or else Ekind (T) = E_Allocator_Type
+           or else Ekind (T) = E_Access_Attribute_Type
          then
             T := Find_Unique_Access_Type;
 
@@ -5086,6 +5144,14 @@ package body Sem_Res is
          Resolve (L, T);
          Resolve (R, T);
 
+         --  If the unique type is a class-wide type then it will be expanded
+         --  into a dispatching call to the predefined primitive. Therefore we
+         --  check here for potential violation of such restriction.
+
+         if Is_Class_Wide_Type (T) then
+            Check_Restriction (No_Dispatching_Calls, N);
+         end if;
+
          if Warn_On_Redundant_Constructs
            and then Comes_From_Source (N)
            and then Is_Entity_Name (R)
@@ -5112,7 +5178,7 @@ package body Sem_Res is
          then
             Eval_Relational_Op (N);
          elsif Nkind (N) = N_Op_Ne
-           and then Is_Abstract (Entity (N))
+           and then Is_Abstract_Subprogram (Entity (N))
          then
             Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N));
          end if;
@@ -5341,8 +5407,18 @@ package body Sem_Res is
          end loop;
       end if;
 
-      Warn_On_Suspicious_Index (Name, First (Expressions (N)));
-      Eval_Indexed_Component (N);
+      --  Do not generate the warning on suspicious index if we are analyzing
+      --  package Ada.Tags; otherwise we will report the warning with the
+      --  Prims_Ptr field of the dispatch table.
+
+      if Scope (Etype (Prefix (N))) = Standard_Standard
+        or else not
+          Is_RTU (Cunit_Entity (Get_Source_Unit (Etype (Prefix (N)))),
+                  Ada_Tags)
+      then
+         Warn_On_Suspicious_Index (Name, First (Expressions (N)));
+         Eval_Indexed_Component (N);
+      end if;
    end Resolve_Indexed_Component;
 
    -----------------------------
@@ -6498,7 +6574,20 @@ package body Sem_Res is
          Index := First_Index (Array_Type);
          Resolve (Drange, Base_Type (Etype (Index)));
 
-         if Nkind (Drange) = N_Range then
+         if Nkind (Drange) = N_Range
+
+            --  Do not apply the range check to nodes associated with the
+            --  frontend expansion of the dispatch table. We first check
+            --  if Ada.Tags is already loaded to void the addition of an
+            --  undesired dependence on such run-time unit.
+
+           and then not
+             (RTU_Loaded (Ada_Tags)
+              and then Nkind (Prefix (N)) = N_Selected_Component
+              and then Present (Entity (Selector_Name (Prefix (N))))
+              and then Entity (Selector_Name (Prefix (N)))
+                         = RTE_Record_Component (RE_Prims_Ptr))
+         then
             Apply_Range_Check (Drange, Etype (Index));
          end if;
       end if;
@@ -6881,6 +6970,15 @@ package body Sem_Res is
 
       Eval_Type_Conversion (N);
 
+      --  Even when evaluation is not possible, we may be able to simplify
+      --  the conversion or its expression. This needs to be done before
+      --  applying checks, since otherwise the checks may use the original
+      --  expression and defeat the simplifications. The is specifically
+      --  the case for elimination of the floating-point Truncation
+      --  attribute in float-to-int conversions.
+
+      Simplify_Type_Conversion (N);
+
       --  If after evaluation, we still have a type conversion, then we
       --  may need to apply checks required for a subtype conversion.
 
@@ -6929,8 +7027,13 @@ package body Sem_Res is
       end if;
 
       --  Ada 2005 (AI-251): Handle conversions to abstract interface types
+      --  No need to perform any interface conversion if the type of the
+      --  expression coincides with the target type.
 
-      if Ada_Version >= Ada_05 and then Expander_Active then
+      if Ada_Version >= Ada_05
+        and then Expander_Active
+        and then Opnd_Type /= Target_Type
+      then
          if Is_Access_Type (Target_Type) then
             Target_Type := Directly_Designated_Type (Target_Type);
          end if;
@@ -6994,18 +7097,7 @@ package body Sem_Res is
       Hi    : Uint;
 
    begin
-      --  Generate warning for expressions like -5 mod 3
-
-      if Warn_On_Questionable_Missing_Parens
-        and then Paren_Count (N) = 0
-        and then (Nkind (N) = N_Op_Minus or else Nkind (N) = N_Op_Plus)
-        and then Paren_Count (Right_Opnd (N)) = 0
-        and then Nkind (Right_Opnd (N)) in N_Multiplying_Operator
-        and then Comes_From_Source (N)
-      then
-         Error_Msg_N
-           ("?unary minus expression should be parenthesized here", N);
-      end if;
+      --  Deal with intrincis unary operators
 
       if Comes_From_Source (N)
         and then Ekind (Entity (N)) = E_Function
@@ -7016,8 +7108,11 @@ package body Sem_Res is
          return;
       end if;
 
+      --  Deal with universal cases
+
       if Etype (R) = Universal_Integer
-           or else Etype (R) = Universal_Real
+           or else
+         Etype (R) = Universal_Real
       then
          Check_For_Visible_Operator (N, B_Typ);
       end if;
@@ -7038,6 +7133,8 @@ package body Sem_Res is
          end if;
       end if;
 
+      --  Deal with reference generation
+
       Check_Unset_Reference (R);
       Generate_Operator_Reference (N, B_Typ);
       Eval_Unary_Op (N);
@@ -7051,6 +7148,135 @@ package body Sem_Res is
             Enable_Overflow_Check (N);
          end if;
       end if;
+
+      --  Generate warning for expressions like -5 mod 3 for integers. No
+      --  need to worry in the floating-point case, since parens do not affect
+      --  the result so there is no point in giving in a warning.
+
+      declare
+         Norig : constant Node_Id := Original_Node (N);
+         Rorig : Node_Id;
+         Val   : Uint;
+         HB    : Uint;
+         LB    : Uint;
+         Lval  : Uint;
+         Opnd  : Node_Id;
+
+      begin
+         if Warn_On_Questionable_Missing_Parens
+           and then Comes_From_Source (Norig)
+           and then Is_Integer_Type (Typ)
+           and then Nkind (Norig) = N_Op_Minus
+         then
+            Rorig := Original_Node (Right_Opnd (Norig));
+
+            --  We are looking for cases where the right operand is not
+            --  parenthesized, and is a bianry operator, multiply, divide, or
+            --  mod. These are the cases where the grouping can affect results.
+
+            if Paren_Count (Rorig) = 0
+              and then (Nkind (Rorig) = N_Op_Mod
+                          or else
+                        Nkind (Rorig) = N_Op_Multiply
+                          or else
+                        Nkind (Rorig) = N_Op_Divide)
+            then
+               --  For mod, we always give the warning, since the value is
+               --  affected by the parenthesization (e.g. (-5) mod 315 /=
+               --  (5 mod 315)). But for the other cases, the only concern is
+               --  overflow, e.g. for the case of 8 big signed (-(2 * 64)
+               --  overflows, but (-2) * 64 does not). So we try to give the
+               --  message only when overflow is possible.
+
+               if Nkind (Rorig) /= N_Op_Mod
+                 and then Compile_Time_Known_Value (R)
+               then
+                  Val := Expr_Value (R);
+
+                  if Compile_Time_Known_Value (Type_High_Bound (Typ)) then
+                     HB := Expr_Value (Type_High_Bound (Typ));
+                  else
+                     HB := Expr_Value (Type_High_Bound (Base_Type (Typ)));
+                  end if;
+
+                  if Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
+                     LB := Expr_Value (Type_Low_Bound (Typ));
+                  else
+                     LB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
+                  end if;
+
+                  --  Note that the test below is deliberately excluding
+                  --  the largest negative number, since that is a potentially
+                  --  troublesome case (e.g. -2 * x, where the result is the
+                  --  largest negative integer has an overflow with 2 * x).
+
+                  if Val > LB and then Val <= HB then
+                     return;
+                  end if;
+               end if;
+
+               --  For the multiplication case, the only case we have to worry
+               --  about is when (-a)*b is exactly the largest negative number
+               --  so that -(a*b) can cause overflow. This can only happen if
+               --  a is a power of 2, and more generally if any operand is a
+               --  constant that is not a power of 2, then the parentheses
+               --  cannot affect whether overflow occurs. We only bother to
+               --  test the left most operand
+
+               --  Loop looking at left operands for one that has known value
+
+               Opnd := Rorig;
+               Opnd_Loop : while Nkind (Opnd) = N_Op_Multiply loop
+                  if Compile_Time_Known_Value (Left_Opnd (Opnd)) then
+                     Lval := UI_Abs (Expr_Value (Left_Opnd (Opnd)));
+
+                     --  Operand value of 0 or 1 skips warning
+
+                     if Lval <= 1 then
+                        return;
+
+                     --  Otherwise check power of 2, if power of 2, warn, if
+                     --  anything else, skip warning.
+
+                     else
+                        while Lval /= 2 loop
+                           if Lval mod 2 = 1 then
+                              return;
+                           else
+                              Lval := Lval / 2;
+                           end if;
+                        end loop;
+
+                        exit Opnd_Loop;
+                     end if;
+                  end if;
+
+                  --  Keep looking at left operands
+
+                  Opnd := Left_Opnd (Opnd);
+               end loop Opnd_Loop;
+
+               --  For rem or "/" we can only have a problematic situation
+               --  if the divisor has a value of minus one or one. Otherwise
+               --  overflow is impossible (divisor > 1) or we have a case of
+               --  division by zero in any case.
+
+               if (Nkind (Rorig) = N_Op_Divide
+                    or else
+                   Nkind (Rorig) = N_Op_Rem)
+                 and then Compile_Time_Known_Value (Right_Opnd (Rorig))
+                 and then UI_Abs (Expr_Value (Right_Opnd (Rorig))) /= 1
+               then
+                  return;
+               end if;
+
+               --  If we fall through warning should be issued
+
+               Error_Msg_N
+                 ("?unary minus expression should be parenthesized here", N);
+            end if;
+         end if;
+      end;
    end Resolve_Unary_Op;
 
    ----------------------------------
@@ -7318,7 +7544,7 @@ package body Sem_Res is
          begin
             Index_Subtype :=
               Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
-            Drange := Make_Range (Loc, Low_Bound, High_Bound);
+            Drange := Make_Range (Loc, New_Copy_Tree (Low_Bound), High_Bound);
             Set_Scalar_Range (Index_Subtype, Drange);
             Set_Parent (Drange, N);
             Analyze_And_Resolve (Drange, Index_Type);
@@ -7347,6 +7573,47 @@ package body Sem_Res is
       end if;
    end Set_String_Literal_Subtype;
 
+   ------------------------------
+   -- Simplify_Type_Conversion --
+   ------------------------------
+
+   procedure Simplify_Type_Conversion (N : Node_Id) is
+   begin
+      if Nkind (N) = N_Type_Conversion then
+         declare
+            Operand    : constant Node_Id   := Expression (N);
+            Target_Typ : constant Entity_Id := Etype (N);
+            Opnd_Typ   : constant Entity_Id := Etype (Operand);
+
+         begin
+            if Is_Floating_Point_Type (Opnd_Typ)
+              and then
+                (Is_Integer_Type (Target_Typ)
+                   or else (Is_Fixed_Point_Type (Target_Typ)
+                              and then Conversion_OK (N)))
+              and then Nkind (Operand) = N_Attribute_Reference
+              and then Attribute_Name (Operand) = Name_Truncation
+
+            --  Special processing required if the conversion is the expression
+            --  of a Truncation attribute reference. In this case we replace:
+
+            --     ityp (ftyp'Truncation (x))
+
+            --  by
+
+            --     ityp (x)
+
+            --  with the Float_Truncate flag set, which is more efficient
+
+            then
+               Rewrite (Operand,
+                 Relocate_Node (First (Expressions (Operand))));
+               Set_Float_Truncate (N, True);
+            end if;
+         end;
+      end if;
+   end Simplify_Type_Conversion;
+
    -----------------------------
    -- Unique_Fixed_Point_Type --
    -----------------------------
@@ -7643,10 +7910,10 @@ package body Sem_Res is
               Conversion_Check (False,
                 "downward conversion of tagged objects not allowed");
 
-         --  Ada 2005 (AI-251): The conversion of a tagged type to an
-         --  abstract interface type is always valid
+         --  Ada 2005 (AI-251): The conversion to/from interface types is
+         --  always valid
 
-         elsif Is_Interface (Target_Type) then
+         elsif Is_Interface (Target_Type) or else Is_Interface (Opnd_Type) then
             return True;
 
          elsif Is_Access_Type (Opnd_Type)
@@ -7988,15 +8255,38 @@ package body Sem_Res is
          end if;
 
          declare
-            Target : constant Entity_Id := Designated_Type (Target_Type);
-            Opnd   : constant Entity_Id := Designated_Type (Opnd_Type);
+            function Full_Designated_Type (T : Entity_Id) return Entity_Id;
+            --  Helper function to handle limited views
+
+            --------------------------
+            -- Full_Designated_Type --
+            --------------------------
+
+            function Full_Designated_Type (T : Entity_Id) return Entity_Id is
+               Desig : constant Entity_Id := Designated_Type (T);
+            begin
+               if From_With_Type (Desig)
+                 and then Is_Incomplete_Type (Desig)
+                 and then Present (Non_Limited_View (Desig))
+               then
+                  return Non_Limited_View (Desig);
+               else
+                  return Desig;
+               end if;
+            end Full_Designated_Type;
+
+            Target : constant Entity_Id := Full_Designated_Type (Target_Type);
+            Opnd   : constant Entity_Id := Full_Designated_Type (Opnd_Type);
+
+            Same_Base : constant Boolean :=
+                          Base_Type (Target) = Base_Type (Opnd);
 
          begin
             if Is_Tagged_Type (Target) then
                return Valid_Tagged_Conversion (Target, Opnd);
 
             else
-               if Base_Type (Target) /= Base_Type (Opnd) then
+               if not Same_Base then
                   Error_Msg_NE
                     ("target designated type not compatible with }",
                      N, Base_Type (Opnd));
@@ -8031,10 +8321,27 @@ package body Sem_Res is
                or else
              Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
         and then No (Corresponding_Remote_Type (Opnd_Type))
-        and then Conversion_Check
-                   (Ekind (Base_Type (Opnd_Type)) = E_Access_Subprogram_Type,
-                    "illegal operand for access subprogram conversion")
       then
+         if
+           Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type
+         then
+            Error_Msg_N
+              ("illegal attempt to store anonymous access to subprogram",
+               Operand);
+            Error_Msg_N
+              ("\value has deeper accessibility than any master " &
+               "('R'M 3.10.2 (13))",
+               Operand);
+
+            if Is_Entity_Name (Operand)
+              and then Ekind (Entity (Operand)) = E_In_Parameter
+            then
+               Error_Msg_NE
+                 ("\use named access type for& instead of access parameter",
+                  Operand, Entity (Operand));
+            end if;
+         end if;
+
          --  Check that the designated types are subtype conformant
 
          Check_Subtype_Conformant (New_Id  => Designated_Type (Target_Type),