[multiple changes]

2015-03-04  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb: Minor reformatting.
	* exp_unst.adb (Build_Tables): Fix minor glitch for no separate
	spec case.
	* erroutc.adb (Delete_Msg): add missing decrement of info msg counter.

2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Build_Pragma_Check_Equivalent): Suppress
	references to formal parameters subject to pragma Unreferenced.
	(Suppress_Reference): New routine.
	* sem_attr.adb (Analyze_Attribute): Reimplement the analysis
	of attribute 'Old. Attributes 'Old and 'Result now share
	common processing.
	(Analyze_Old_Result_Attribute): New routine.
	(Check_Placement_In_Check): Removed.
	(Check_Placement_In_Contract_Cases): Removed.
	(Check_Placement_In_Test_Case): Removed.
	(Check_Use_In_Contract_Cases): Removed.
	(Check_Use_In_Test_Case): Removed.
	(In_Refined_Post): Removed.
	(Is_Within): Removed.
	* sem_warn.adb (Check_Low_Bound_Tested): Code cleanup.
	(Check_Low_Bound_Tested_For): New routine.

2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration):
	Generate a runtime check to test the expression of pragma
	Default_Initial_Condition when the object is default initialized.

From-SVN: r221176

gcc/ada/ChangeLog

+2015-03-04  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch7.adb: Minor reformatting.
+	* exp_unst.adb (Build_Tables): Fix minor glitch for no separate
+	spec case.
+	* erroutc.adb (Delete_Msg): add missing decrement of info msg counter.
+
+2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb (Build_Pragma_Check_Equivalent): Suppress
+	references to formal parameters subject to pragma Unreferenced.
+	(Suppress_Reference): New routine.
+	* sem_attr.adb (Analyze_Attribute): Reimplement the analysis
+	of attribute 'Old. Attributes 'Old and 'Result now share
+	common processing.
+	(Analyze_Old_Result_Attribute): New routine.
+	(Check_Placement_In_Check): Removed.
+	(Check_Placement_In_Contract_Cases): Removed.
+	(Check_Placement_In_Test_Case): Removed.
+	(Check_Use_In_Contract_Cases): Removed.
+	(Check_Use_In_Test_Case): Removed.
+	(In_Refined_Post): Removed.
+	(Is_Within): Removed.
+	* sem_warn.adb (Check_Low_Bound_Tested): Code cleanup.
+	(Check_Low_Bound_Tested_For): New routine.
+
+2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration):
+	Generate a runtime check to test the expression of pragma
+	Default_Initial_Condition when the object is default initialized.
+
 2015-03-02  Robert Dewar  <dewar@adacore.com>
 
 	* scng.adb (Scan): Ignore illegal character in relaxed

gcc/ada/erroutc.adb

@@ -141,6 +141,10 @@ package body Erroutc is
             if Errors.Table (D).Warn or else Errors.Table (D).Style then
                Warnings_Detected := Warnings_Detected - 1;
 
+               if Errors.Table (D).Info then
+                  Info_Messages := Info_Messages - 1;
+               end if;
+
                --  Note: we do not need to decrement Warnings_Treated_As_Errors
                --  because this only gets incremented if we actually output the
                --  message, which we won't do if we are deleting it here!

gcc/ada/exp_ch3.adb

@@ -6138,11 +6138,9 @@ package body Exp_Ch3 is
          end;
       end if;
 
-      --  At this point the object is fully initialized by either invoking the
-      --  related type init proc, routine [Deep_]Initialize or performing in-
-      --  place assingments for an array object. If the related type is subject
-      --  to pragma Default_Initial_Condition, add a runtime check to verify
-      --  the assumption of the pragma. Generate:
+      --  If the object is default initialized and its type is subject to
+      --  pragma Default_Initial_Condition, add a runtime check to verify
+      --  the assumption of the pragma (SPARK RM 7.3.3). Generate:
 
       --    <Base_Typ>Default_Init_Cond (<Base_Typ> (Def_Id));
 
@@ -6152,6 +6150,7 @@ package body Exp_Ch3 is
         and then (Has_Default_Init_Cond           (Base_Typ)
                     or else
                   Has_Inherited_Default_Init_Cond (Base_Typ))
+        and then not Has_Init_Expression (N)
       then
          declare
             DIC_Call : constant Node_Id :=

gcc/ada/exp_ch6.adb

@@ -7163,6 +7163,42 @@ package body Exp_Ch6 is
          Subp_Id  : Entity_Id := Empty;
          Inher_Id : Entity_Id := Empty) return Node_Id
       is
+         function Suppress_Reference (N : Node_Id) return Traverse_Result;
+         --  Detect whether node N references a formal parameter subject to
+         --  pragma Unreferenced. If this is the case, set Comes_From_Source
+         --  to False to suppress the generation of a reference when analyzing
+         --  N later on.
+
+         ------------------------
+         -- Suppress_Reference --
+         ------------------------
+
+         function Suppress_Reference (N : Node_Id) return Traverse_Result is
+            Formal : Entity_Id;
+
+         begin
+            if Is_Entity_Name (N) and then Present (Entity (N)) then
+               Formal := Entity (N);
+
+               --  The formal parameter is subject to pragma Unreferenced.
+               --  Prevent the generation of a reference by resetting the
+               --  Comes_From_Source flag.
+
+               if Is_Formal (Formal)
+                 and then Has_Pragma_Unreferenced (Formal)
+               then
+                  Set_Comes_From_Source (N, False);
+               end if;
+            end if;
+
+            return OK;
+         end Suppress_Reference;
+
+         procedure Suppress_References is
+           new Traverse_Proc (Suppress_Reference);
+
+         --  Local variables
+
          Loc          : constant Source_Ptr := Sloc (Prag);
          Prag_Nam     : constant Name_Id    := Pragma_Name (Prag);
          Check_Prag   : Node_Id;
@@ -7172,6 +7208,8 @@ package body Exp_Ch6 is
          Nam          : Name_Id;
          Subp_Formal  : Entity_Id;
 
+      --  Start of processing for Build_Pragma_Check_Equivalent
+
       begin
          Formals_Map := No_Elist;
 
@@ -7208,8 +7246,26 @@ package body Exp_Ch6 is
          --  Mark the pragma as being internally generated and reset the
          --  Analyzed flag.
 
-         Set_Comes_From_Source (Check_Prag, False);
          Set_Analyzed          (Check_Prag, False);
+         Set_Comes_From_Source (Check_Prag, False);
+
+         --  The tree of the original pragma may contain references to the
+         --  formal parameters of the related subprogram. At the same time
+         --  the corresponding body may mark the formals as unreferenced:
+
+         --     procedure Proc (Formal : ...)
+         --       with Pre => Formal ...;
+
+         --     procedure Proc (Formal : ...) is
+         --        pragma Unreferenced (Formal);
+         --     ...
+
+         --  This creates problems because all pragma Check equivalents are
+         --  analyzed at the end of the body declarations. Since all source
+         --  references have already been accounted for, reset any references
+         --  to such formals in the generated pragma Check equivalent.
+
+         Suppress_References (Check_Prag);
 
          if Present (Corresponding_Aspect (Prag)) then
             Nam := Chars (Identifier (Corresponding_Aspect (Prag)));

gcc/ada/exp_ch7.adb

@@ -7853,12 +7853,10 @@ package body Exp_Ch7 is
      (Loc     : Source_Ptr;
       Ptr_Typ : Entity_Id) return Node_Id
    is
-
-      --  It is possible for Ptr_Typ to be a partial view, if the access
-      --  type is a full view declared in the private part of a nested package,
-      --  and the finalization actions take place when completing analysis
-      --  of the enclosing unit. For this reason we use Underlying_Type
-      --  in two places below.
+      --  It is possible for Ptr_Typ to be a partial view, if the access type
+      --  is a full view declared in the private part of a nested package, and
+      --  the finalization actions take place when completing analysis of the
+      --  enclosing unit. For this reason use Underlying_Type twice below.
 
       Desig_Typ : constant Entity_Id :=
                     Available_View

gcc/ada/exp_unst.adb

@@ -491,16 +491,16 @@ package body Exp_Unst is
          --  then we won't catch it in the traversal of the body. But we do
          --  want to visit the declaration in this case!
 
-         declare
-            Dummy : Traverse_Result;
-            Decl  : constant Node_Id :=
-              Parent (Declaration_Node (Corresponding_Spec (Subp_Body)));
-            pragma Assert (Nkind (Decl) = N_Subprogram_Declaration);
-         begin
-            if not Acts_As_Spec (Subp_Body) then
+         if not Acts_As_Spec (Subp_Body) then
+            declare
+               Dummy : Traverse_Result;
+               Decl  : constant Node_Id :=
+                 Parent (Declaration_Node (Corresponding_Spec (Subp_Body)));
+               pragma Assert (Nkind (Decl) = N_Subprogram_Declaration);
+            begin
                Dummy := Visit_Node (Decl);
-            end if;
-         end;
+            end;
+         end if;
 
          --  Traverse the body to get the rest of the subprograms and calls
 

gcc/ada/sem_warn.adb

@@ -723,28 +723,33 @@ package body Sem_Warn is
    ----------------------------
 
    procedure Check_Low_Bound_Tested (Expr : Node_Id) is
+      procedure Check_Low_Bound_Tested_For (Opnd : Node_Id);
+      --  Determine whether operand Opnd denotes attribute 'First whose prefix
+      --  is a formal parameter. If this is the case, mark the entity of the
+      --  prefix as having its low bound tested.
+
+      --------------------------------
+      -- Check_Low_Bound_Tested_For --
+      --------------------------------
+
+      procedure Check_Low_Bound_Tested_For (Opnd : Node_Id) is
+      begin
+         if Nkind (Opnd) = N_Attribute_Reference
+           and then Attribute_Name (Opnd) = Name_First
+           and then Is_Entity_Name (Prefix (Opnd))
+           and then Present (Entity (Prefix (Opnd)))
+           and then Is_Formal (Entity (Prefix (Opnd)))
+         then
+            Set_Low_Bound_Tested (Entity (Prefix (Opnd)));
+         end if;
+      end Check_Low_Bound_Tested_For;
+
+   --  Start of processing for Check_Low_Bound_Tested
+
    begin
       if Comes_From_Source (Expr) then
-         declare
-            L : constant Node_Id := Left_Opnd (Expr);
-            R : constant Node_Id := Right_Opnd (Expr);
-         begin
-            if Nkind (L) = N_Attribute_Reference
-              and then Attribute_Name (L) = Name_First
-              and then Is_Entity_Name (Prefix (L))
-              and then Is_Formal (Entity (Prefix (L)))
-            then
-               Set_Low_Bound_Tested (Entity (Prefix (L)));
-            end if;
-
-            if Nkind (R) = N_Attribute_Reference
-              and then Attribute_Name (R) = Name_First
-              and then Is_Entity_Name (Prefix (R))
-              and then Is_Formal (Entity (Prefix (R)))
-            then
-               Set_Low_Bound_Tested (Entity (Prefix (R)));
-            end if;
-         end;
+         Check_Low_Bound_Tested_For (Left_Opnd  (Expr));
+         Check_Low_Bound_Tested_For (Right_Opnd (Expr));
       end if;
    end Check_Low_Bound_Tested;