+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
-- 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
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;
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
-- 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
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
-- 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.
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;
((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));
-- --
-- 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- --
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 --
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
declare
Source_File : Source_File_Index;
Source_Unit : Unit_Number_Type;
+ Unit_Node : Node_Id;
begin
Source_File := Get_Source_File_Index (S);
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;
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
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
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 --
--------------------------------
-- --
-- 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- --
-- 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
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.
-- 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;
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)
projects / gcc.git / commitdiff