From a5150cb18f6ba057d1c3ab144e12822421fff434 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 14 Jun 2016 14:12:42 +0200 Subject: [PATCH] [multiple changes] 2016-06-14 Arnaud Charlet * exp_ch3.adb (Expand_N_Object_Declaration): Only consider nodes from sources. 2016-06-14 Arnaud Charlet * 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 * 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 * 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. From-SVN: r237431 --- gcc/ada/ChangeLog | 33 +++++++++++++++++++ gcc/ada/exp_ch3.adb | 1 + gcc/ada/gnat1drv.adb | 36 ++++++++++---------- gcc/ada/lib-xref-spark_specific.adb | 25 ++++++++++---- gcc/ada/lib-xref.adb | 6 ++-- gcc/ada/lib.adb | 51 +++++++++++++++++++++++++---- gcc/ada/lib.ads | 10 +++++- gcc/ada/sem_util.adb | 16 +++++++++ gcc/ada/switch-c.adb | 27 ++++++++++++++- 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 + + * exp_ch3.adb (Expand_N_Object_Declaration): Only consider + nodes from sources. + +2016-06-14 Arnaud Charlet + + * 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 + + * 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 + + * 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 * 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) -- 2.30.2