[multiple changes]

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated
	check.
	(Subtypes_Statically_Match): Remove duplicate check.
	* sem_prag.adb (Check_Arg_Is_External_Name): Remove duplicate check.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_aggr.adb (Replace_Type): Remove the special processing
	for selected components.
	* exp_attr.adb (Expand_N_Attribute_Reference): Merge the
	processing for attributes Fixed_Value and Integer_Value.
	* exp_util.adb (Side_Effect_Free): Merge the processing for
	qualified expressions, type conversions, and unchecked type
	conversions.
	* g-comlin.adb (Is_In_Config): Merge the processing for No_Space
	and Optional.
	* par-ch3.adb (P_Declarative_Items): Merge the processing for
	tokens function, not, overriding, and procedure.
	* sem_ch6.adb (Fully_Conformant_Expressions): Merge the processing
	for qualified expressions, type conversions, and unchecked
	type conversions.
	* sem_util.adb (Compile_Time_Constraint_Error): Merge the
	processing for Ada 83 and instances.
	(Object_Access_Level): Merge the processing for indexed components
	and selected components.
	* uname.adb (Add_Node_Name): Merge the processing for stubs.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Install_Primitive_Elaboration_Check):
	Do not generate the check when restriction No_Elaboration_Code
	is in effect.

2017-04-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Build_Class_Wide_Check): New subsidiary
	of Expand_Dispatching_Call. If the denoted subprogram has a
	class-wide precondition, this is the only precondition that
	applies to the call, rather that the class-wide preconditions
	that may apply to the body that is executed. (This is specified
	in AI12-0195).

From-SVN: r247333

13 files changed, 227 insertions, 186 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7c4293d..1be7e3e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,47 @@
+2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated
+	check.
+	(Subtypes_Statically_Match): Remove duplicate check.
+	* sem_prag.adb (Check_Arg_Is_External_Name): Remove duplicate check.
+
+2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_aggr.adb (Replace_Type): Remove the special processing
+	for selected components.
+	* exp_attr.adb (Expand_N_Attribute_Reference): Merge the
+	processing for attributes Fixed_Value and Integer_Value.
+	* exp_util.adb (Side_Effect_Free): Merge the processing for
+	qualified expressions, type conversions, and unchecked type
+	conversions.
+	* g-comlin.adb (Is_In_Config): Merge the processing for No_Space
+	and Optional.
+	* par-ch3.adb (P_Declarative_Items): Merge the processing for
+	tokens function, not, overriding, and procedure.
+	* sem_ch6.adb (Fully_Conformant_Expressions): Merge the processing
+	for qualified expressions, type conversions, and unchecked
+	type conversions.
+	* sem_util.adb (Compile_Time_Constraint_Error): Merge the
+	processing for Ada 83 and instances.
+	(Object_Access_Level): Merge the processing for indexed components
+	and selected components.
+	* uname.adb (Add_Node_Name): Merge the processing for stubs.
+
+2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Install_Primitive_Elaboration_Check):
+	Do not generate the check when restriction No_Elaboration_Code
+	is in effect.
+
+2017-04-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.adb (Build_Class_Wide_Check): New subsidiary
+	of Expand_Dispatching_Call. If the denoted subprogram has a
+	class-wide precondition, this is the only precondition that
+	applies to the call, rather that the class-wide preconditions
+	that may apply to the body that is executed. (This is specified
+	in AI12-0195).
+
 2017-04-27  Yannick Moy  <moy@adacore.com>
 
 	* gnat1drv.adb (Adjust_Global_Switches): Issue
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index d9a36df..fa55615 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -7740,7 +7740,6 @@ package body Checks is
    -----------------------------------------
 
    procedure Install_Primitive_Elaboration_Check (Subp_Body : Node_Id) is
-
       function Within_Compilation_Unit_Instance
         (Subp_Id : Entity_Id) return Boolean;
       --  Determine whether subprogram Subp_Id appears within an instance which
@@ -7796,6 +7795,11 @@ package body Checks is
       if ASIS_Mode or GNATprove_Mode then
          return;
 
+      --  Do not generate an elaboration check if such code is not desirable
+
+      elsif Restriction_Active (No_Elaboration_Code) then
+         return;
+
       --  Do not generate an elaboration check if the related subprogram is
       --  not subjected to accessibility checks.
 
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 685edaa..0cbbd01 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -3042,15 +3042,7 @@ package body Exp_Aggr is
            and then Root_Type (Etype (N)) = Root_Type (Entity (Prefix (Expr)))
          then
             if Is_Entity_Name (Lhs) then
-               Rewrite (Prefix (Expr),
-                 New_Occurrence_Of (Entity (Lhs), Loc));
-
-            elsif Nkind (Lhs) = N_Selected_Component then
-               Rewrite (Expr,
-                 Make_Attribute_Reference (Loc,
-                   Attribute_Name => Name_Unrestricted_Access,
-                   Prefix         => New_Copy_Tree (Lhs)));
-               Set_Analyzed (Parent (Expr), False);
+               Rewrite (Prefix (Expr), New_Occurrence_Of (Entity (Lhs), Loc));
 
             else
                Rewrite (Expr,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index ad6ab41..21a1771 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3360,24 +3360,30 @@ package body Exp_Attr is
          end if;
       end First_Bit_Attr;
 
-      -----------------
-      -- Fixed_Value --
-      -----------------
+      --------------------------------
+      -- Fixed_Value, Integer_Value --
+      --------------------------------
 
-      --  We transform:
+      --  We transform
 
       --     fixtype'Fixed_Value (integer-value)
+      --     inttype'Fixed_Value (fixed-value)
 
       --  into
 
-      --     fixtype(integer-value)
+      --     fixtype (integer-value)
+      --     inttype (fixed-value)
+
+      --  respectively.
 
       --  We do all the required analysis of the conversion here, because we do
       --  not want this to go through the fixed-point conversion circuits. Note
       --  that the back end always treats fixed-point as equivalent to the
       --  corresponding integer type anyway.
 
-      when Attribute_Fixed_Value =>
+      when Attribute_Fixed_Value
+         | Attribute_Integer_Value
+      =>
          Rewrite (N,
            Make_Type_Conversion (Loc,
              Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
@@ -3924,37 +3930,6 @@ package body Exp_Attr is
       end Input;
 
       -------------------
-      -- Integer_Value --
-      -------------------
-
-      --  We transform
-
-      --    inttype'Fixed_Value (fixed-value)
-
-      --  into
-
-      --    inttype(integer-value))
-
-      --  we do all the required analysis of the conversion here, because we do
-      --  not want this to go through the fixed-point conversion circuits. Note
-      --  that the back end always treats fixed-point as equivalent to the
-      --  corresponding integer type anyway.
-
-      when Attribute_Integer_Value =>
-         Rewrite (N,
-           Make_Type_Conversion (Loc,
-             Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
-             Expression   => Relocate_Node (First (Exprs))));
-         Set_Etype (N, Entity (Pref));
-         Set_Analyzed (N);
-
-         --  Note: it might appear that a properly analyzed unchecked
-         --  conversion would be just fine here, but that's not the case, since
-         --  the full range check performed by the following call is critical.
-
-         Apply_Type_Conversion_Checks (N);
-
-      -------------------
       -- Invalid_Value --
       -------------------
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 0a6a03b..d1822c4 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -58,6 +58,7 @@ with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -649,11 +650,112 @@ package body Exp_Disp is
       Eq_Prim_Op      : Entity_Id := Empty;
       Controlling_Tag : Node_Id;
 
+      procedure Build_Class_Wide_Check;
+      --  If the denoted subprogram has a class-wide precondition, generate
+      --  a check using that precondition before the dispatching call, because
+      --  this is the only class-wide precondition that applies to the call.
+
       function New_Value (From : Node_Id) return Node_Id;
       --  From is the original Expression. New_Value is equivalent to a call
       --  to Duplicate_Subexpr with an explicit dereference when From is an
       --  access parameter.
 
+      ----------------------------
+      -- Build_Class_Wide_Check --
+      ----------------------------
+
+      procedure Build_Class_Wide_Check is
+         Prec    : Node_Id;
+         Cond    : Node_Id;
+         Msg     : Node_Id;
+         Str_Loc : constant String := Build_Location_String (Loc);
+
+         function Replace_Formals (N : Node_Id) return Traverse_Result;
+         --  Replace occurrences of the formals of the subprogram by the
+         --  corresponding actuals in the call, given that this check is
+         --  performed outside of the body of the subprogram.
+
+         ---------------------
+         -- Replace_Formals --
+         ---------------------
+
+         function Replace_Formals (N : Node_Id) return Traverse_Result is
+         begin
+            if Is_Entity_Name (N)
+              and then Present (Entity (N))
+              and then Is_Formal (Entity (N))
+            then
+               declare
+                  A : Node_Id;
+                  F : Entity_Id;
+
+               begin
+                  F := First_Formal (Subp);
+                  A := First_Actual (Call_Node);
+                  while Present (F) loop
+                     if F = Entity (N) then
+                        Rewrite (N, New_Copy_Tree (A));
+                        exit;
+                     end if;
+                     Next_Formal (F);
+                     Next_Actual (A);
+                  end loop;
+               end;
+            end if;
+
+            return OK;
+         end Replace_Formals;
+
+         procedure Update is new Traverse_Proc (Replace_Formals);
+      begin
+
+         --  Locate class-wide precondition, if any
+
+         if Present (Contract (Subp))
+           and then Present (Pre_Post_Conditions (Contract (Subp)))
+         then
+            Prec := Pre_Post_Conditions (Contract (Subp));
+
+            while Present (Prec) loop
+               exit when Pragma_Name (Prec) = Name_Precondition
+                 and then Class_Present (Prec);
+               Prec := Next_Pragma (Prec);
+            end loop;
+
+            if No (Prec) then
+               return;
+            end if;
+
+            --  The expression for the precondition is analyzed within the
+            --  generated pragma. The message text is the last parameter
+            --  of the generated pragma, indicating source of precondition.
+
+            Cond := New_Copy_Tree
+              (Expression (First (Pragma_Argument_Associations (Prec))));
+            Update (Cond);
+
+            --  Build message indicating the failed precondition and the
+            --  dispatching call that caused it.
+
+            Msg := Expression (Last (Pragma_Argument_Associations (Prec)));
+            Name_Len := 0;
+            Append (Global_Name_Buffer, Strval (Msg));
+            Append (Global_Name_Buffer, " in dispatching call at ");
+            Append (Global_Name_Buffer, Str_Loc);
+            Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len));
+
+            Insert_Action (Call_Node,
+               Make_If_Statement (Loc,
+                  Condition => Make_Op_Not (Loc, Cond),
+                  Then_Statements => New_List (
+                     Make_Procedure_Call_Statement (Loc,
+                       Name                   =>
+                         New_Occurrence_Of
+                           (RTE (RE_Raise_Assert_Failure), Loc),
+                       Parameter_Associations => New_List (Msg)))));
+         end if;
+      end Build_Class_Wide_Check;
+
       ---------------
       -- New_Value --
       ---------------
@@ -714,6 +816,8 @@ package body Exp_Disp is
          Subp := Alias (Subp);
       end if;
 
+      Build_Class_Wide_Check;
+
       --  Definition of the class-wide type and the tagged type
 
       --  If the controlling argument is itself a tag rather than a tagged
@@ -1174,7 +1278,7 @@ package body Exp_Disp is
       if not Tagged_Type_Expansion then
          return;
 
-      --  A static conversion to an interface type that is not classwide is
+      --  A static conversion to an interface type that is not class-wide is
       --  curious but legal if the interface operation is a null procedure.
       --  If the operation is abstract it will be rejected later.
 
@@ -1190,7 +1294,7 @@ package body Exp_Disp is
 
       if not Is_Static then
 
-         --  Give error if configurable run time and Displace not available
+         --  Give error if configurable run-time and Displace not available
 
          if not RTE_Available (RE_Displace) then
             Error_Msg_CRT ("dynamic interface conversion", N);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2c23841..0c87e1f 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -12942,10 +12942,13 @@ package body Exp_Util is
               Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
                 and then Safe_Prefixed_Reference (N);
 
-         --  A type qualification is side effect free if the expression
-         --  is side effect free.
+         --  A type qualification, type conversion, or unchecked expression is
+         --  side effect free if the expression is side effect free.
 
-         when N_Qualified_Expression =>
+         when N_Qualified_Expression
+            | N_Type_Conversion
+            | N_Unchecked_Expression
+         =>
             return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
 
          --  A selected component is side effect free only if it is a side
@@ -12969,12 +12972,6 @@ package body Exp_Util is
                Side_Effect_Free (Discrete_Range (N), Name_Req, Variable_Ref)
                  and then Safe_Prefixed_Reference (N);
 
-         --  A type conversion is side effect free if the expression to be
-         --  converted is side effect free.
-
-         when N_Type_Conversion =>
-            return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
-
          --  A unary operator is side effect free if the operand
          --  is side effect free.
 
@@ -12990,12 +12987,6 @@ package body Exp_Util is
                 and then Side_Effect_Free
                            (Expression (N), Name_Req, Variable_Ref);
 
-         --  An unchecked expression is side effect free if its expression
-         --  is side effect free.
-
-         when N_Unchecked_Expression =>
-            return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
-
          --  A literal is side effect free
 
          when N_Character_Literal
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index ef76fee..978040e 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2017, 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- --
@@ -2002,12 +2002,9 @@ package body GNAT.Command_Line is
                   Found_In_Config := True;
                   return False;
 
-               when Parameter_No_Space =>
-                  Callback (Switch, "", Parameter, Index);
-                  Found_In_Config := True;
-                  return False;
-
-               when Parameter_Optional =>
+               when Parameter_No_Space
+                  | Parameter_Optional
+               =>
                   Callback (Switch, "", Parameter, Index);
                   Found_In_Config := True;
                   return False;
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 5c84664..529c501 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -4319,7 +4319,11 @@ package body Ch3 is
       end if;
 
       case Token is
-         when Tok_Function =>
+         when Tok_Function
+            | Tok_Not
+            | Tok_Overriding
+            | Tok_Procedure
+         =>
             Check_Bad_Layout;
             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
             Done := False;
@@ -4374,20 +4378,6 @@ package body Ch3 is
                P_Identifier_Declarations (Decls, Done, In_Spec);
             end if;
 
-         --  Ada 2005: A subprogram declaration can start with "not" or
-         --  "overriding". In older versions, "overriding" is handled
-         --  like an identifier, with the appropriate messages.
-
-         when Tok_Not =>
-            Check_Bad_Layout;
-            Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
-            Done := False;
-
-         when Tok_Overriding =>
-            Check_Bad_Layout;
-            Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
-            Done := False;
-
          when Tok_Package =>
             Check_Bad_Layout;
             Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
@@ -4397,11 +4387,6 @@ package body Ch3 is
             Append (P_Pragma, Decls);
             Done := False;
 
-         when Tok_Procedure =>
-            Check_Bad_Layout;
-            Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
-            Done := False;
-
          when Tok_Protected =>
             Check_Bad_Layout;
             Scan; -- past PROTECTED
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 32384d9..9ba68b1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8981,7 +8981,10 @@ package body Sem_Ch6 is
                    and then FCE (Explicit_Actual_Parameter (E1),
                                  Explicit_Actual_Parameter (E2));
 
-            when N_Qualified_Expression =>
+            when N_Qualified_Expression
+               | N_Type_Conversion
+               | N_Unchecked_Type_Conversion
+            =>
                return
                  FCE (Subtype_Mark (E1), Subtype_Mark (E2))
                    and then
@@ -9084,24 +9087,12 @@ package body Sem_Ch6 is
                   end if;
                end;
 
-            when N_Type_Conversion =>
-               return
-                 FCE (Subtype_Mark (E1), Subtype_Mark (E2))
-                   and then
-                 FCE (Expression (E1), Expression (E2));
-
             when N_Unary_Op =>
                return
                  Entity (E1) = Entity (E2)
                    and then
                  FCE (Right_Opnd (E1), Right_Opnd (E2));
 
-            when N_Unchecked_Type_Conversion =>
-               return
-                 FCE (Subtype_Mark (E1), Subtype_Mark (E2))
-                   and then
-                 FCE (Expression (E1), Expression (E2));
-
             --  All other node types cannot appear in this context. Strictly
             --  we should raise a fatal internal error. Instead we just ignore
             --  the nodes. This means that if anyone makes a mistake in the
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 24e0963..41941ba 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -5681,14 +5681,6 @@ package body Sem_Eval is
          then
             return False;
 
-         --  If either type has constraint error bounds, then consider that
-         --  they match to avoid junk cascaded errors here.
-
-         elsif not Is_OK_Static_Subtype (T1)
-           or else not Is_OK_Static_Subtype (T2)
-         then
-            return True;
-
          --  Base types must match, but we don't check that (should we???) but
          --  we do at least check that both types are real, or both types are
          --  not real.
@@ -5708,19 +5700,17 @@ package body Sem_Eval is
             begin
                if Is_Real_Type (T1) then
                   return
-                    (Expr_Value_R (LB1) > Expr_Value_R (HB1))
+                    Expr_Value_R (LB1) > Expr_Value_R (HB1)
                       or else
-                    (Expr_Value_R (LB2) <= Expr_Value_R (LB1)
-                       and then
-                     Expr_Value_R (HB1) <= Expr_Value_R (HB2));
+                        (Expr_Value_R (LB2) <= Expr_Value_R (LB1)
+                          and then Expr_Value_R (HB1) <= Expr_Value_R (HB2));
 
                else
                   return
-                    (Expr_Value (LB1) > Expr_Value (HB1))
+                    Expr_Value (LB1) > Expr_Value (HB1)
                       or else
-                    (Expr_Value (LB2) <= Expr_Value (LB1)
-                       and then
-                     Expr_Value (HB1) <= Expr_Value (HB2));
+                        (Expr_Value (LB2) <= Expr_Value (LB1)
+                          and then Expr_Value (HB1) <= Expr_Value (HB2));
                end if;
             end;
          end if;
@@ -5728,17 +5718,20 @@ package body Sem_Eval is
       --  Access types
 
       elsif Is_Access_Type (T1) then
-         return (not Is_Constrained (T2)
-                  or else (Subtypes_Statically_Match
-                             (Designated_Type (T1), Designated_Type (T2))))
+         return
+           (not Is_Constrained (T2)
+             or else Subtypes_Statically_Match
+                       (Designated_Type (T1), Designated_Type (T2)))
            and then not (Can_Never_Be_Null (T2)
                           and then not Can_Never_Be_Null (T1));
 
       --  All other cases
 
       else
-         return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
-           or else Subtypes_Statically_Match (T1, T2, Formal_Derived_Matching);
+         return
+           (Is_Composite_Type (T1) and then not Is_Constrained (T2))
+             or else Subtypes_Statically_Match
+                       (T1, T2, Formal_Derived_Matching);
       end if;
    end Subtypes_Statically_Compatible;
 
@@ -5856,23 +5849,16 @@ package body Sem_Eval is
 
             else
                if not Is_OK_Static_Subtype (T1)
-                 or else not Is_OK_Static_Subtype (T2)
+                    or else
+                  not Is_OK_Static_Subtype (T2)
                then
                   return False;
 
-               --  If either type has constraint error bounds, then say that
-               --  they match to avoid junk cascaded errors here.
-
-               elsif not Is_OK_Static_Subtype (T1)
-                 or else not Is_OK_Static_Subtype (T2)
-               then
-                  return True;
-
                elsif Is_Real_Type (T1) then
                   return
-                    (Expr_Value_R (LB1) = Expr_Value_R (LB2))
+                    Expr_Value_R (LB1) = Expr_Value_R (LB2)
                       and then
-                    (Expr_Value_R (HB1) = Expr_Value_R (HB2));
+                    Expr_Value_R (HB1) = Expr_Value_R (HB2);
 
                else
                   return
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 5e90f7b..9cbd2242 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4905,25 +4905,15 @@ package body Sem_Prag is
             then
                return;
 
-            --  Static expression that raises Constraint_Error. This has
-            --  already been flagged, so just exit from pragma processing.
-
-            elsif Is_OK_Static_Expression (Argx) then
-               raise Pragma_Exit;
-
             --  Here we have a real error (non-static expression)
 
             else
                Error_Msg_Name_1 := Pname;
+               Flag_Non_Static_Expr
+                 (Fix_Error ("argument for pragma% must be a identifier or "
+                  & "static string expression!"), Argx);
 
-               declare
-                  Msg : constant String :=
-                          "argument for pragma% must be a identifier or "
-                          & "static string expression!";
-               begin
-                  Flag_Non_Static_Expr (Fix_Error (Msg), Argx);
-                  raise Pragma_Exit;
-               end;
+               raise Pragma_Exit;
             end if;
          end if;
       end Check_Arg_Is_External_Name;
@@ -4936,8 +4926,7 @@ package body Sem_Prag is
          Argx : constant Node_Id := Get_Pragma_Arg (Arg);
       begin
          if Nkind (Argx) /= N_Identifier then
-            Error_Pragma_Arg
-              ("argument for pragma% must be identifier", Argx);
+            Error_Pragma_Arg ("argument for pragma% must be identifier", Argx);
          end if;
       end Check_Arg_Is_Identifier;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 200417a..b01ee08 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4958,8 +4958,8 @@ package body Sem_Util is
             Eloc := Sloc (N);
          end if;
 
-         --  Copy message to Msgc, converting any ? in the message into
-         --  < instead, so that we have an error in GNATprove mode.
+         --  Copy message to Msgc, converting any ? in the message into <
+         --  instead, so that we have an error in GNATprove mode.
 
          Msgl := Msg'Length;
 
@@ -4976,12 +4976,13 @@ package body Sem_Util is
          if Msg (Msg'Last) = '?' or else Msg (Msg'Last) = '<' then
             Wmsg := True;
 
-         --  In Ada 83, all messages are warnings. In the private part and
-         --  the body of an instance, constraint_checks are only warnings.
-         --  We also make this a warning if the Warn parameter is set.
+         --  In Ada 83, all messages are warnings. In the private part and the
+         --  body of an instance, constraint_checks are only warnings. We also
+         --  make this a warning if the Warn parameter is set.
 
          elsif Warn
            or else (Ada_Version = Ada_83 and then Comes_From_Source (N))
+           or else In_Instance_Not_Visible
          then
             Msgl := Msgl + 1;
             Msgc (Msgl) := '<';
@@ -4989,18 +4990,11 @@ package body Sem_Util is
             Msgc (Msgl) := '<';
             Wmsg := True;
 
-         elsif In_Instance_Not_Visible then
-            Msgl := Msgl + 1;
-            Msgc (Msgl) := '<';
-            Msgl := Msgl + 1;
-            Msgc (Msgl) := '<';
-            Wmsg := True;
-
-         --  Otherwise we have a real error message (Ada 95 static case)
-         --  and we make this an unconditional message. Note that in the
-         --  warning case we do not make the message unconditional, it seems
-         --  quite reasonable to delete messages like this (about exceptions
-         --  that will be raised) in dead code.
+         --  Otherwise we have a real error message (Ada 95 static case) and we
+         --  make this an unconditional message. Note that in the warning case
+         --  we do not make the message unconditional, it seems reasonable to
+         --  delete messages like this (about exceptions that will be raised)
+         --  in dead code.
 
          else
             Wmsg := False;
@@ -19118,14 +19112,7 @@ package body Sem_Util is
             end if;
          end if;
 
-      elsif Nkind (Obj) = N_Selected_Component then
-         if Is_Access_Type (Etype (Prefix (Obj))) then
-            return Type_Access_Level (Etype (Prefix (Obj)));
-         else
-            return Object_Access_Level (Prefix (Obj));
-         end if;
-
-      elsif Nkind (Obj) = N_Indexed_Component then
+      elsif Nkind_In (Obj, N_Indexed_Component, N_Selected_Component) then
          if Is_Access_Type (Etype (Prefix (Obj))) then
             return Type_Access_Level (Etype (Prefix (Obj)));
          else
diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb
index 562ee0e..e5a6c87 100644
--- a/gcc/ada/uname.adb
+++ b/gcc/ada/uname.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -300,12 +300,8 @@ package body Uname is
                when N_Compilation_Unit =>
                   Add_Node_Name (Unit (Node));
 
-               when N_Package_Body_Stub =>
-                  Add_Node_Name (Get_Parent (Node));
-                  Add_Char ('.');
-                  Add_Node_Name (Defining_Identifier (Node));
-
-               when N_Protected_Body_Stub
+               when N_Package_Body_Stub
+                  | N_Protected_Body_Stub
                   | N_Task_Body_Stub
                =>
                   Add_Node_Name (Get_Parent (Node));