2016-06-14 Arnaud Charlet <charlet@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Only consider
	nodes from sources.

2016-06-14  Arnaud Charlet  <charlet@adacore.com>

	* switch-c.adb, gnat1drv.adb (Adjust_Global_Switches): Only disable
	simple value propagation in CodePeer mode when warnings are disabled.
	(Scan_Front_End_Switches): Enable relevant front-end switches
	when using -gnateC.

2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Is_OK_Volatile_Context): A
	reference to a volatile object is considered OK if appears as
	the prefix of attributes Address, Alignment, Component_Size,
	First_Bit, Last_Bit, Position, Size, Storage_Size.

2016-06-14  Yannick Moy  <moy@adacore.com>

	* lib-xref-spark_specific.adb (Add_SPARK_File): Do not traverse
	subunits directly, as they are already traversed as part of the
	top-level unit to which they belong.
	(Add_SPARK_Xrefs): Add assertions to ensure correct sorting.
	(Generate_Dereference): Use unique definition place for special
	variable __HEAP, to ensure correct sorting of references.
	* lib-xref.adb (Generate_Reference): Use top-level unit in case
	of subunits.
	* lib.adb, lib.ads (Get_Top_Level_Code_Unit): New functions that
	compute the top-level code unit for a source location of AST node,
	that go past subunits.



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

9 files changed, 170 insertions, 35 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 930e86681ff..f975cf7123a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2016-06-14  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): Only consider
+	nodes from sources.
+
+2016-06-14  Arnaud Charlet  <charlet@adacore.com>
+
+	* switch-c.adb, gnat1drv.adb (Adjust_Global_Switches): Only disable
+	simple value propagation in CodePeer mode when warnings are disabled.
+	(Scan_Front_End_Switches): Enable relevant front-end switches
+	when using -gnateC.
+
+2016-06-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_util.adb (Is_OK_Volatile_Context): A
+	reference to a volatile object is considered OK if appears as
+	the prefix of attributes Address, Alignment, Component_Size,
+	First_Bit, Last_Bit, Position, Size, Storage_Size.
+
+2016-06-14  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-spark_specific.adb (Add_SPARK_File): Do not traverse
+	subunits directly, as they are already traversed as part of the
+	top-level unit to which they belong.
+	(Add_SPARK_Xrefs): Add assertions to ensure correct sorting.
+	(Generate_Dereference): Use unique definition place for special
+	variable __HEAP, to ensure correct sorting of references.
+	* lib-xref.adb (Generate_Reference): Use top-level unit in case
+	of subunits.
+	* lib.adb, lib.ads (Get_Top_Level_Code_Unit): New functions that
+	compute the top-level code unit for a source location of AST node,
+	that go past subunits.
+
 2016-06-13  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (gnat_to_gnu_subprog_type): Build only a minimal
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 74d3902f529..18249d83a44 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6868,6 +6868,7 @@ package body Exp_Ch3 is
             --  from previous instantiation errors.
 
             if Validity_Checks_On
+              and then Comes_From_Source (N)
               and then Validity_Check_Copies
               and then not Is_Generic_Type (Etype (Def_Id))
             then
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 02950a59926..0e5c670261c 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -296,8 +296,7 @@ procedure Gnat1drv is
          Debug_Generated_Code := False;
 
          --  Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
-         --  Do we really need to spend time generating xref in CodePeer
-         --  mode??? Consider setting Xref_Active to False.
+         --  to support source navigation.
 
          Xref_Active := True;
 
@@ -318,24 +317,15 @@ procedure Gnat1drv is
 
          Assertions_Enabled := True;
 
-         --  Disable all simple value propagation. This is an optimization
-         --  which is valuable for code optimization, and also for generation
-         --  of compiler warnings, but these are being turned off by default,
-         --  and CodePeer generates better messages (referencing original
-         --  variables) this way.
-
-         Debug_Flag_MM := True;
-
-         --  Set normal RM validity checking, and checking of IN OUT parameters
-         --  (this might give CodePeer more useful checks to analyze, to be
-         --  confirmed???). All other validity checking is turned off, since
-         --  this can generate very complex trees that only confuse CodePeer
-         --  and do not bring enough useful info.
+         --  Set normal RM validity checking and checking of copies (to catch
+         --  e.g.  wrong values used in unchecked conversions).
+         --  All other validity checking is turned off, since this can generate
+         --  very complex trees that only confuse CodePeer and do not bring
+         --  enough useful info.
 
          Reset_Validity_Check_Options;
          Validity_Check_Default       := True;
-         Validity_Check_In_Out_Params := True;
-         Validity_Check_In_Params     := True;
+         Validity_Check_Copies        := True;
 
          --  Turn off style check options and ignore any style check pragmas
          --  since we are not interested in any front-end warnings when we are
@@ -356,6 +346,18 @@ procedure Gnat1drv is
          --  This is useful when using CodePeer mode with other compilers.
 
          Relaxed_RM_Semantics := True;
+
+         --  Disable all simple value propagation. This is an optimization
+         --  which is valuable for code optimization, and also for generation
+         --  of compiler warnings, but these are being turned off by default,
+         --  and CodePeer generates better messages (referencing original
+         --  variables) this way.
+         --  Do this only is -gnatws is set (the default with -gnatcC), so that
+         --  if warnings are enabled, we'll get better messages from GNAT.
+
+         if Warning_Mode = Suppress then
+            Debug_Flag_MM := True;
+         end if;
       end if;
 
       --  Enable some individual switches that are implied by relaxed RM
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index c05029a3704..081a362677d 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -150,6 +150,15 @@ package body SPARK_Specific is
          return;
       end if;
 
+      --  Subunits are traversed as part of the top-level unit to which they
+      --  belong.
+
+      if Present (Cunit (Ubody))
+        and then Nkind (Unit (Cunit (Ubody))) = N_Subunit
+      then
+         return;
+      end if;
+
       From := SPARK_Scope_Table.Last + 1;
 
       --  Unit might not have an associated compilation unit, as seen in code
@@ -610,6 +619,8 @@ package body SPARK_Specific is
             --  Both entities must be equal at this point
 
             pragma Assert (T1.Key.Ent = T2.Key.Ent);
+            pragma Assert (T1.Key.Ent_Scope = T2.Key.Ent_Scope);
+            pragma Assert (T1.Ent_Scope_File = T2.Ent_Scope_File);
 
             --  Fourth test: if reference is in same unit as entity definition,
             --  sort first.
@@ -1210,18 +1221,20 @@ package body SPARK_Specific is
             Deref.Loc := Loc;
             Deref.Typ := Typ;
 
-            --  It is as if the special "Heap" was defined in every scope where
-            --  it is referenced.
+            --  It is as if the special "Heap" was defined in the main unit,
+            --  in the scope of the entity for the main unit. This single
+            --  definition point is required to ensure that sorting cross
+            --  references works for "Heap" references as well.
 
-            Deref.Eun := Get_Code_Unit (Loc);
-            Deref.Lun := Get_Code_Unit (Loc);
+            Deref.Eun := Main_Unit;
+            Deref.Lun := Get_Top_Level_Code_Unit (Loc);
 
             Deref.Ref_Scope := Ref_Scope;
-            Deref.Ent_Scope := Ref_Scope;
+            Deref.Ent_Scope := Cunit_Entity (Main_Unit);
 
             Deref_Entry.Def := No_Location;
 
-            Deref_Entry.Ent_Scope_File := Get_Code_Unit (N);
+            Deref_Entry.Ent_Scope_File := Main_Unit;
          end;
       end if;
    end Generate_Dereference;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index ef4acb5d43f..c8c0b8556f2 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1075,11 +1075,11 @@ package body Lib.Xref is
               ((Ent       => Ent,
                 Loc       => Ref,
                 Typ       => Actual_Typ,
-                Eun       => Get_Code_Unit (Def),
-                Lun       => Get_Code_Unit (Ref),
+                Eun       => Get_Top_Level_Code_Unit (Def),
+                Lun       => Get_Top_Level_Code_Unit (Ref),
                 Ref_Scope => Ref_Scope,
                 Ent_Scope => Ent_Scope),
-               Ent_Scope_File => Get_Code_Unit (Ent));
+               Ent_Scope_File => Get_Top_Level_Code_Unit (Ent));
 
          else
             Ref := Original_Location (Sloc (Nod));
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 08866b2fb55..4b9343245fc 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -68,9 +68,12 @@ package body Lib is
 
    function Get_Code_Or_Source_Unit
      (S                : Source_Ptr;
-      Unwind_Instances : Boolean) return Unit_Number_Type;
-   --  Common code for Get_Code_Unit (get unit of instantiation for location)
-   --  and Get_Source_Unit (get unit of template for location).
+      Unwind_Instances : Boolean;
+      Unwind_Subunits  : Boolean) return Unit_Number_Type;
+   --  Common code for Get_Code_Unit (get unit of instantiation for
+   --  location) Get_Source_Unit (get unit of template for location) and
+   --  Get_Top_Level_Code_Unit (same as Get_Code_Unit but not stopping at
+   --  subunits).
 
    --------------------------------------------
    -- Access Functions for Unit Table Fields --
@@ -573,7 +576,8 @@ package body Lib is
 
    function Get_Code_Or_Source_Unit
      (S                : Source_Ptr;
-      Unwind_Instances : Boolean) return Unit_Number_Type
+      Unwind_Instances : Boolean;
+      Unwind_Subunits  : Boolean) return Unit_Number_Type
    is
    begin
       --  Search table unless we have No_Location, which can happen if the
@@ -584,6 +588,7 @@ package body Lib is
          declare
             Source_File : Source_File_Index;
             Source_Unit : Unit_Number_Type;
+            Unit_Node   : Node_Id;
 
          begin
             Source_File := Get_Source_File_Index (S);
@@ -596,6 +601,21 @@ package body Lib is
 
             Source_Unit := Unit (Source_File);
 
+            if Unwind_Subunits then
+               Unit_Node := Unit (Cunit (Source_Unit));
+
+               while Nkind (Unit_Node) = N_Subunit
+                 and then Present (Corresponding_Stub (Unit_Node))
+               loop
+                  Source_Unit :=
+                    Get_Code_Or_Source_Unit
+                      (Sloc (Corresponding_Stub (Unit_Node)),
+                       Unwind_Instances => Unwind_Instances,
+                       Unwind_Subunits  => Unwind_Subunits);
+                  Unit_Node := Unit (Cunit (Source_Unit));
+               end loop;
+            end if;
+
             if Source_Unit /= No_Unit then
                return Source_Unit;
             end if;
@@ -616,7 +636,7 @@ package body Lib is
    function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
    begin
       return Get_Code_Or_Source_Unit (Top_Level_Location (S),
-        Unwind_Instances => False);
+        Unwind_Instances => False, Unwind_Subunits => False);
    end Get_Code_Unit;
 
    function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
@@ -691,7 +711,8 @@ package body Lib is
 
    function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is
    begin
-      return Get_Code_Or_Source_Unit (S, Unwind_Instances => True);
+      return Get_Code_Or_Source_Unit (S,
+        Unwind_Instances => True, Unwind_Subunits => False);
    end Get_Source_Unit;
 
    function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
@@ -699,6 +720,22 @@ package body Lib is
       return Get_Source_Unit (Sloc (N));
    end Get_Source_Unit;
 
+   -----------------------------
+   -- Get_Top_Level_Code_Unit --
+   -----------------------------
+
+   function Get_Top_Level_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
+   begin
+      return Get_Code_Or_Source_Unit (Top_Level_Location (S),
+        Unwind_Instances => False, Unwind_Subunits => True);
+   end Get_Top_Level_Code_Unit;
+
+   function Get_Top_Level_Code_Unit
+     (N : Node_Or_Entity_Id) return Unit_Number_Type is
+   begin
+      return Get_Top_Level_Code_Unit (Sloc (N));
+   end Get_Top_Level_Code_Unit;
+
    --------------------------------
    -- In_Extended_Main_Code_Unit --
    --------------------------------
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index 50825a86be6..2f0ccca1e3b 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -541,6 +541,14 @@ package Lib is
    --  template, so it returns the unit number containing the code that
    --  corresponds to the node N, or the source location S.
 
+   function Get_Top_Level_Code_Unit
+     (N : Node_Or_Entity_Id) return Unit_Number_Type;
+   pragma Inline (Get_Code_Unit);
+   function Get_Top_Level_Code_Unit (S : Source_Ptr) return Unit_Number_Type;
+   --  This is like Get_Code_Unit, except that in the case of subunits, it
+   --  returns the top-level unit to which the subunit belongs instead of
+   --  the subunit.
+
    function In_Extended_Main_Code_Unit
      (N : Node_Or_Entity_Id) return Boolean;
    --  Return True if the node is in the generated code of the extended main
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3b241bde58a..f7f41f21ce8 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13637,6 +13637,22 @@ package body Sem_Util is
       then
          return True;
 
+      --  The volatile object appears as the prefix of attributes Address,
+      --  Alignment, Component_Size, First_Bit, Last_Bit, Position, Size,
+      --  Storage_Size.
+
+      elsif Nkind (Context) = N_Attribute_Reference
+        and then Prefix (Context) = Obj_Ref
+        and then Nam_In (Attribute_Name (Context), Name_Alignment,
+                                                   Name_Component_Size,
+                                                   Name_First_Bit,
+                                                   Name_Last_Bit,
+                                                   Name_Position,
+                                                   Name_Size,
+                                                   Name_Storage_Size)
+      then
+         return True;
+
       --  The volatile object appears as the expression of a type conversion
       --  occurring in a non-interfering context.
 
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index b282245ddcd..4aac84738f3 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -28,6 +28,7 @@
 --  circularities, especially for back ends using Adabkend.
 
 with Debug;    use Debug;
+with Errout;   use Errout;
 with Lib;      use Lib;
 with Osint;    use Osint;
 with Opt;      use Opt;
@@ -531,7 +532,31 @@ package body Switch.C is
 
                   when 'C' =>
                      Ptr := Ptr + 1;
-                     Generate_CodePeer_Messages := True;
+
+                     if not Generate_CodePeer_Messages then
+                        Generate_CodePeer_Messages := True;
+                        CodePeer_Mode              := True;
+                        Warning_Mode               := Normal;
+                        Warning_Doc_Switch         := True;  -- -gnatw.d
+
+                        --  Enable warnings potentially useful for non GNAT
+                        --  users.
+
+                        Constant_Condition_Warnings      := True; -- -gnatwc
+                        Warn_On_Assertion_Failure        := True; -- -gnatw.a
+                        Warn_On_Assumed_Low_Bound        := True; -- -gnatww
+                        Warn_On_Bad_Fixed_Value          := True; -- -gnatwb
+                        Warn_On_Biased_Representation    := True; -- -gnatw.b
+                        Warn_On_Export_Import            := True; -- -gnatwx
+                        Warn_On_Modified_Unread          := True; -- -gnatwm
+                        Warn_On_No_Value_Assigned        := True; -- -gnatwv
+                        Warn_On_Object_Renames_Function  := True; -- -gnatw.r
+                        Warn_On_Overlap                  := True; -- -gnatw.i
+                        Warn_On_Parameter_Order          := True; -- -gnatw.p
+                        Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
+                        Warn_On_Redundant_Constructs     := True; -- -gnatwr
+                        Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
+                     end if;
 
                   --  -gnated switch (disable atomic synchronization)