Skip to content

R
riscv-gcc-1
Commit a5150cb1 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r237431
parent 3970e545
Showing with 170 additions and 35 deletions
gcc/ada/ChangeLog
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> 2016-06-13 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_subprog_type): Build only a minimal * gcc-interface/decl.c (gnat_to_gnu_subprog_type): Build only a minimal
......
gcc/ada/exp_ch3.adb
...@@ -6868,6 +6868,7 @@ package body Exp_Ch3 is ...@@ -6868,6 +6868,7 @@ package body Exp_Ch3 is
-- from previous instantiation errors. -- from previous instantiation errors.
if Validity_Checks_On if Validity_Checks_On
and then Comes_From_Source (N)
and then Validity_Check_Copies and then Validity_Check_Copies
and then not Is_Generic_Type (Etype (Def_Id)) and then not Is_Generic_Type (Etype (Def_Id))
then then
......
gcc/ada/gnat1drv.adb
...@@ -296,8 +296,7 @@ procedure Gnat1drv is ...@@ -296,8 +296,7 @@ procedure Gnat1drv is
Debug_Generated_Code := False; Debug_Generated_Code := False;
-- Turn cross-referencing on in case it was disabled (e.g. by -gnatD) -- Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
-- Do we really need to spend time generating xref in CodePeer -- to support source navigation.
-- mode??? Consider setting Xref_Active to False.
Xref_Active := True; Xref_Active := True;
...@@ -318,24 +317,15 @@ procedure Gnat1drv is ...@@ -318,24 +317,15 @@ procedure Gnat1drv is
Assertions_Enabled := True; Assertions_Enabled := True;
-- Disable all simple value propagation. This is an optimization -- Set normal RM validity checking and checking of copies (to catch
-- which is valuable for code optimization, and also for generation -- e.g. wrong values used in unchecked conversions).
-- of compiler warnings, but these are being turned off by default, -- All other validity checking is turned off, since this can generate
-- and CodePeer generates better messages (referencing original -- very complex trees that only confuse CodePeer and do not bring
-- variables) this way. -- enough useful info.
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.
Reset_Validity_Check_Options; Reset_Validity_Check_Options;
Validity_Check_Default := True; Validity_Check_Default := True;
Validity_Check_In_Out_Params := True; Validity_Check_Copies := True;
Validity_Check_In_Params := True;
-- Turn off style check options and ignore any style check pragmas -- Turn off style check options and ignore any style check pragmas
-- since we are not interested in any front-end warnings when we are -- since we are not interested in any front-end warnings when we are
...@@ -356,6 +346,18 @@ procedure Gnat1drv is ...@@ -356,6 +346,18 @@ procedure Gnat1drv is
-- This is useful when using CodePeer mode with other compilers. -- This is useful when using CodePeer mode with other compilers.
Relaxed_RM_Semantics := True; 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; end if;
-- Enable some individual switches that are implied by relaxed RM -- Enable some individual switches that are implied by relaxed RM
......
gcc/ada/lib-xref-spark_specific.adb
...@@ -150,6 +150,15 @@ package body SPARK_Specific is ...@@ -150,6 +150,15 @@ package body SPARK_Specific is
return; return;
end if; 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; From := SPARK_Scope_Table.Last + 1;
-- Unit might not have an associated compilation unit, as seen in code -- Unit might not have an associated compilation unit, as seen in code
...@@ -610,6 +619,8 @@ package body SPARK_Specific is ...@@ -610,6 +619,8 @@ package body SPARK_Specific is
-- Both entities must be equal at this point -- Both entities must be equal at this point
pragma Assert (T1.Key.Ent = T2.Key.Ent); 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, -- Fourth test: if reference is in same unit as entity definition,
-- sort first. -- sort first.
...@@ -1210,18 +1221,20 @@ package body SPARK_Specific is ...@@ -1210,18 +1221,20 @@ package body SPARK_Specific is
Deref.Loc := Loc; Deref.Loc := Loc;
Deref.Typ := Typ; Deref.Typ := Typ;
-- It is as if the special "Heap" was defined in every scope where -- It is as if the special "Heap" was defined in the main unit,
-- it is referenced. -- 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.Eun := Main_Unit;
Deref.Lun := Get_Code_Unit (Loc); Deref.Lun := Get_Top_Level_Code_Unit (Loc);
Deref.Ref_Scope := Ref_Scope; Deref.Ref_Scope := Ref_Scope;
Deref.Ent_Scope := Ref_Scope; Deref.Ent_Scope := Cunit_Entity (Main_Unit);
Deref_Entry.Def := No_Location; Deref_Entry.Def := No_Location;
Deref_Entry.Ent_Scope_File := Get_Code_Unit (N); Deref_Entry.Ent_Scope_File := Main_Unit;
end; end;
end if; end if;
end Generate_Dereference; end Generate_Dereference;
......
gcc/ada/lib-xref.adb
...@@ -1075,11 +1075,11 @@ package body Lib.Xref is ...@@ -1075,11 +1075,11 @@ package body Lib.Xref is
((Ent => Ent, ((Ent => Ent,
Loc => Ref, Loc => Ref,
Typ => Actual_Typ, Typ => Actual_Typ,
Eun => Get_Code_Unit (Def), Eun => Get_Top_Level_Code_Unit (Def),
Lun => Get_Code_Unit (Ref), Lun => Get_Top_Level_Code_Unit (Ref),
Ref_Scope => Ref_Scope, Ref_Scope => Ref_Scope,
Ent_Scope => Ent_Scope), Ent_Scope => Ent_Scope),
Ent_Scope_File => Get_Code_Unit (Ent)); Ent_Scope_File => Get_Top_Level_Code_Unit (Ent));
else else
Ref := Original_Location (Sloc (Nod)); Ref := Original_Location (Sloc (Nod));
......
gcc/ada/lib.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -68,9 +68,12 @@ package body Lib is ...@@ -68,9 +68,12 @@ package body Lib is
function Get_Code_Or_Source_Unit function Get_Code_Or_Source_Unit
(S : Source_Ptr; (S : Source_Ptr;
Unwind_Instances : Boolean) return Unit_Number_Type; Unwind_Instances : Boolean;
-- Common code for Get_Code_Unit (get unit of instantiation for location) Unwind_Subunits : Boolean) return Unit_Number_Type;
-- and Get_Source_Unit (get unit of template for location). -- 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 -- -- Access Functions for Unit Table Fields --
...@@ -573,7 +576,8 @@ package body Lib is ...@@ -573,7 +576,8 @@ package body Lib is
function Get_Code_Or_Source_Unit function Get_Code_Or_Source_Unit
(S : Source_Ptr; (S : Source_Ptr;
Unwind_Instances : Boolean) return Unit_Number_Type Unwind_Instances : Boolean;
Unwind_Subunits : Boolean) return Unit_Number_Type
is is
begin begin
-- Search table unless we have No_Location, which can happen if the -- Search table unless we have No_Location, which can happen if the
...@@ -584,6 +588,7 @@ package body Lib is ...@@ -584,6 +588,7 @@ package body Lib is
declare declare
Source_File : Source_File_Index; Source_File : Source_File_Index;
Source_Unit : Unit_Number_Type; Source_Unit : Unit_Number_Type;
Unit_Node : Node_Id;
begin begin
Source_File := Get_Source_File_Index (S); Source_File := Get_Source_File_Index (S);
...@@ -596,6 +601,21 @@ package body Lib is ...@@ -596,6 +601,21 @@ package body Lib is
Source_Unit := Unit (Source_File); 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 if Source_Unit /= No_Unit then
return Source_Unit; return Source_Unit;
end if; end if;
...@@ -616,7 +636,7 @@ package body Lib is ...@@ -616,7 +636,7 @@ package body Lib is
function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type is
begin begin
return Get_Code_Or_Source_Unit (Top_Level_Location (S), return Get_Code_Or_Source_Unit (Top_Level_Location (S),
Unwind_Instances => False); Unwind_Instances => False, Unwind_Subunits => False);
end Get_Code_Unit; end Get_Code_Unit;
function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
...@@ -691,7 +711,8 @@ package body Lib is ...@@ -691,7 +711,8 @@ package body Lib is
function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type is
begin 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; end Get_Source_Unit;
function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type is
...@@ -699,6 +720,22 @@ package body Lib is ...@@ -699,6 +720,22 @@ package body Lib is
return Get_Source_Unit (Sloc (N)); return Get_Source_Unit (Sloc (N));
end Get_Source_Unit; 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 -- -- In_Extended_Main_Code_Unit --
-------------------------------- --------------------------------
......
gcc/ada/lib.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -541,6 +541,14 @@ package Lib is ...@@ -541,6 +541,14 @@ package Lib is
-- template, so it returns the unit number containing the code that -- template, so it returns the unit number containing the code that
-- corresponds to the node N, or the source location S. -- 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 function In_Extended_Main_Code_Unit
(N : Node_Or_Entity_Id) return Boolean; (N : Node_Or_Entity_Id) return Boolean;
-- Return True if the node is in the generated code of the extended main -- Return True if the node is in the generated code of the extended main
......
gcc/ada/sem_util.adb
...@@ -13637,6 +13637,22 @@ package body Sem_Util is ...@@ -13637,6 +13637,22 @@ package body Sem_Util is
then then
return True; 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 -- The volatile object appears as the expression of a type conversion
-- occurring in a non-interfering context. -- occurring in a non-interfering context.
......
gcc/ada/switch-c.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
-- circularities, especially for back ends using Adabkend. -- circularities, especially for back ends using Adabkend.
with Debug; use Debug; with Debug; use Debug;
with Errout; use Errout;
with Lib; use Lib; with Lib; use Lib;
with Osint; use Osint; with Osint; use Osint;
with Opt; use Opt; with Opt; use Opt;
...@@ -531,7 +532,31 @@ package body Switch.C is ...@@ -531,7 +532,31 @@ package body Switch.C is
when 'C' => when 'C' =>
Ptr := Ptr + 1; 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) -- -gnated switch (disable atomic synchronization)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment