OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Pragma_Check): Remove
	bogus circuitry for the case where Name is Predicate.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb(Traverse_Declarations_Or_Statements.Traverse_Aspects):
	Create SCOs for Predicate aspects in disabled
	state initially, to be enabled later on by...
	* sem_ch13.adb (Build_Predicate_Functions.Add_Predicates): Mark
	SCO for predicate as enabled.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* comperr.adb (Compiler_Abort): Remove now obsolete pair of
	pragmas Warnings Off / On.
	* namet.adb (Finalize): Remove now obsolete pair of pragmas
	Warnings Off / On.
	* output.adb: Remove now obsolete pair of pragmas Warnings Off / On.
	* sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not
	consider comparisons between static expressions because their
	values cannot be invalidated.
	* urealp.adb (Tree_Read): Remove now obsolete pair of pragmas
	Warnings Off / On.
	(Tree_Write): Remove now obsolete pair of pragmas Warnings Off / On.
	* usage.adb Remove now obsolete pair of pragmas Warnings Off / On.

2017-04-25  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (In_Task_Activation): Trace internal calls in
	task bodies.

From-SVN: r247227
This commit is contained in:
Arnaud Charlet 2017-04-25 15:25:06 +02:00
parent c66cda60fe
commit 628078425b
12 changed files with 135 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gcc/ada/ChangeLog
View File

@ -1,3 +1,36 @@
2017-04-25 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Pragma_Check): Remove
bogus circuitry for the case where Name is Predicate.
2017-04-25 Thomas Quinot <quinot@adacore.com>
* par_sco.adb(Traverse_Declarations_Or_Statements.Traverse_Aspects):
Create SCOs for Predicate aspects in disabled
state initially, to be enabled later on by...
* sem_ch13.adb (Build_Predicate_Functions.Add_Predicates): Mark
SCO for predicate as enabled.
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* comperr.adb (Compiler_Abort): Remove now obsolete pair of
pragmas Warnings Off / On.
* namet.adb (Finalize): Remove now obsolete pair of pragmas
Warnings Off / On.
* output.adb: Remove now obsolete pair of pragmas Warnings Off / On.
* sem_warn.adb (Warn_On_Constant_Valid_Condition): Do not
consider comparisons between static expressions because their
values cannot be invalidated.
* urealp.adb (Tree_Read): Remove now obsolete pair of pragmas
Warnings Off / On.
(Tree_Write): Remove now obsolete pair of pragmas Warnings Off / On.
* usage.adb Remove now obsolete pair of pragmas Warnings Off / On.
2017-04-25 Bob Duff <duff@adacore.com>
* sem_elab.adb (In_Task_Activation): Trace internal calls in
task bodies.
2017-04-25 Gary Dismukes <dismukes@adacore.com> 2017-04-25 Gary Dismukes <dismukes@adacore.com>
* sem_prag.adb, sem_warn.adb, sem_eval.adb: Minor reformatting and * sem_prag.adb, sem_warn.adb, sem_eval.adb: Minor reformatting and

9
gcc/ada/comperr.adb
View File

@ -98,18 +98,9 @@ package body Comperr is
Write_Eol; Write_Eol;
end End_Line; end End_Line;
-- Disable the warnings emitted by -gnatwc because the following two
-- constants are initialized by means of conditional compilation.
pragma Warnings
(Off, "condition can only be * if invalid values present");
Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL; Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL;
Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF; Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF;
pragma Warnings
(On, "condition can only be * if invalid values present");
-- Start of processing for Compiler_Abort -- Start of processing for Compiler_Abort
begin begin

9
gcc/ada/namet.adb
View File

@ -672,12 +672,6 @@ package body Namet is
Max_Chain_Length := C; Max_Chain_Length := C;
end if; end if;
-- Disable the warnings emitted by -gnatwc because the tests
-- involving Verbosity involve conditional compilation.
pragma Warnings
(Off, "condition can only be * if invalid values present");
if Verbosity >= 2 then if Verbosity >= 2 then
Write_Str ("Hash_Table ("); Write_Str ("Hash_Table (");
Write_Int (J); Write_Int (J);
@ -709,9 +703,6 @@ package body Namet is
N := Name_Entries.Table (N).Hash_Link; N := Name_Entries.Table (N).Hash_Link;
end loop; end loop;
end if; end if;
pragma Warnings
(On, "condition can only be * if invalid values present");
end; end;
end if; end if;
end loop; end loop;

5
gcc/ada/output.adb
View File

@ -55,12 +55,7 @@ package body Output is
Indentation_Limit : constant Positive := 40; Indentation_Limit : constant Positive := 40;
-- Indentation beyond this number of spaces wraps around -- Indentation beyond this number of spaces wraps around
-- Disable the warnings emitted by -gnatwc because the comparison within
-- the assertion depends on conditional compilation.
pragma Warnings (Off, "condition can only be * if invalid values present");
pragma Assert (Indentation_Limit < Buffer_Max / 2); pragma Assert (Indentation_Limit < Buffer_Max / 2);
pragma Warnings (On, "condition can only be * if invalid values present");
-- Make sure this is substantially shorter than the line length -- Make sure this is substantially shorter than the line length
Cur_Indentation : Natural := 0; Cur_Indentation : Natural := 0;

29
gcc/ada/par_sco.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009-2016, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2017, 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- --
@ -1678,7 +1678,15 @@ package body Par_SCO is
-- Aspects rewritten into pragmas controlled by a Check_Policy: -- Aspects rewritten into pragmas controlled by a Check_Policy:
-- Current_Pragma_Sloc must be set to the sloc of the aspect -- Current_Pragma_Sloc must be set to the sloc of the aspect
-- specification. The corresponding pragma will have the same -- specification. The corresponding pragma will have the same
-- sloc. -- sloc. Note that Invariant, Pre, and Post will be enabled if
-- the policy is Check; on the other hand, predicate aspects
-- will be enabled for Check and Ignore (when Add_Predicate
-- is called) because the actual checks occur in client units.
-- When the assertion policy for Predicate is Disable, the
-- SCO remains disabled, because Add_Predicate is never called.
-- Pre/post can have checks in client units too because of
-- inheritance, so should they receive the same treatment???
when Aspect_Invariant when Aspect_Invariant
| Aspect_Post | Aspect_Post
@ -1686,24 +1694,11 @@ package body Par_SCO is
| Aspect_Pre | Aspect_Pre
| Aspect_Precondition | Aspect_Precondition
| Aspect_Type_Invariant | Aspect_Type_Invariant
=> | Aspect_Dynamic_Predicate
C1 := 'a';
-- Aspects whose checks are generated in client units,
-- regardless of whether or not the check is activated in the
-- unit which contains the declaration: create decision as
-- unconditionally enabled aspect (but still make a pragma
-- entry since Set_SCO_Pragma_Enabled will be called when
-- analyzing actual checks, possibly in other units).
-- Pre/post can have checks in client units too because of
-- inheritance, so should they be moved here???
when Aspect_Dynamic_Predicate
| Aspect_Predicate | Aspect_Predicate
| Aspect_Static_Predicate | Aspect_Static_Predicate
=> =>
C1 := 'A'; C1 := 'a';
-- Other aspects: just process any decision nested in the -- Other aspects: just process any decision nested in the
-- aspect expression. -- aspect expression.

5
gcc/ada/sem_ch13.adb
View File

@ -42,6 +42,7 @@ with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
with Par_SCO; use Par_SCO;
with Restrict; use Restrict; with Restrict; use Restrict;
with Rident; use Rident; with Rident; use Rident;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
@ -8419,6 +8420,10 @@ package body Sem_Ch13 is
-- Start of processing for Add_Predicate -- Start of processing for Add_Predicate
begin begin
-- Mark corresponding SCO as enabled
Set_SCO_Pragma_Enabled (Sloc (Prag));
-- Extract the arguments of the pragma. The expression itself -- Extract the arguments of the pragma. The expression itself
-- is copied for use in the predicate function, to preserve the -- is copied for use in the predicate function, to preserve the
-- original version for ASIS use. -- original version for ASIS use.

107
gcc/ada/sem_elab.adb
View File

@ -70,26 +70,26 @@ package body Sem_Elab is
Ent : Entity_Id; Ent : Entity_Id;
end record; end record;
package Elab_Call is new Table.Table ( package Elab_Call is new Table.Table
Table_Component_Type => Elab_Call_Entry, (Table_Component_Type => Elab_Call_Entry,
Table_Index_Type => Int, Table_Index_Type => Int,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 50, Table_Initial => 50,
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Elab_Call"); Table_Name => "Elab_Call");
-- This table is initialized at the start of each outer level call. It -- This table is initialized at the start of each outer level call. It
-- holds the entities for all subprograms that have been examined for this -- holds the entities for all subprograms that have been examined for this
-- particular outer level call, and is used to prevent both infinite -- particular outer level call, and is used to prevent both infinite
-- recursion, and useless reanalysis of bodies already seen -- recursion, and useless reanalysis of bodies already seen
package Elab_Visited is new Table.Table ( package Elab_Visited is new Table.Table
Table_Component_Type => Entity_Id, (Table_Component_Type => Entity_Id,
Table_Index_Type => Int, Table_Index_Type => Int,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Elab_Visited"); Table_Name => "Elab_Visited");
-- This table stores calls to Check_Internal_Call that are delayed until -- This table stores calls to Check_Internal_Call that are delayed until
-- all generics are instantiated and in particular until after all generic -- all generics are instantiated and in particular until after all generic
@ -112,23 +112,29 @@ package body Sem_Elab is
-- The current scope of the call. This is restored when we complete the -- The current scope of the call. This is restored when we complete the
-- delayed call, so that we do this in the right scope. -- delayed call, so that we do this in the right scope.
From_SPARK_Code : Boolean; Outer_Scope : Entity_Id;
-- Save indication of whether this call is under SPARK_Mode => On -- Save scope of outer level call
From_Elab_Code : Boolean; From_Elab_Code : Boolean;
-- Save indication of whether this call is from elaboration code -- Save indication of whether this call is from elaboration code
Outer_Scope : Entity_Id; In_Task_Activation : Boolean;
-- Save scope of outer level call -- Save indication of whether this call is from a task body. Tasks are
-- activated at the "begin", which is after all local procedure bodies,
-- so calls to those procedures can't fail, even if they occur after the
-- task body.
From_SPARK_Code : Boolean;
-- Save indication of whether this call is under SPARK_Mode => On
end record; end record;
package Delay_Check is new Table.Table ( package Delay_Check is new Table.Table
Table_Component_Type => Delay_Element, (Table_Component_Type => Delay_Element,
Table_Index_Type => Int, Table_Index_Type => Int,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 1000, Table_Initial => 1000,
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Delay_Check"); Table_Name => "Delay_Check");
C_Scope : Entity_Id; C_Scope : Entity_Id;
-- Top-level scope of current scope. Compute this only once at the outer -- Top-level scope of current scope. Compute this only once at the outer
@ -145,10 +151,12 @@ package body Sem_Elab is
-- routines in other units if this flag is True. -- routines in other units if this flag is True.
In_Task_Activation : Boolean := False; In_Task_Activation : Boolean := False;
-- This flag indicates whether we are performing elaboration checks on -- This flag indicates whether we are performing elaboration checks on task
-- task procedures, at the point of activation. If true, we do not trace -- bodies, at the point of activation. If true, we do not raise
-- internal calls in these procedures, because all local bodies are known -- Program_Error for calls to local procedures, because all local bodies
-- to be elaborated. -- are known to be elaborated. However, we still need to trace such calls,
-- because a local procedure could call a procedure in another package,
-- so we might need an implicit Elaborate_All.
Delaying_Elab_Checks : Boolean := True; Delaying_Elab_Checks : Boolean := True;
-- This is set True till the compilation is complete, including the -- This is set True till the compilation is complete, including the
@ -242,7 +250,7 @@ package body Sem_Elab is
Orig_Ent : Entity_Id); Orig_Ent : Entity_Id);
-- The processing for Check_Internal_Call is divided up into two phases, -- The processing for Check_Internal_Call is divided up into two phases,
-- and this represents the second phase. The second phase is delayed if -- and this represents the second phase. The second phase is delayed if
-- Delaying_Elab_Calls is set to True. In this delayed case, the first -- Delaying_Elab_Checks is set to True. In this delayed case, the first
-- phase makes an entry in the Delay_Check table, which is processed when -- phase makes an entry in the Delay_Check table, which is processed when
-- Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to -- Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to
-- Check_Internal_Call. Outer_Scope is the outer level scope for the -- Check_Internal_Call. Outer_Scope is the outer level scope for the
@ -1956,6 +1964,7 @@ package body Sem_Elab is
for J in Delay_Check.First .. Delay_Check.Last loop for J in Delay_Check.First .. Delay_Check.Last loop
Push_Scope (Delay_Check.Table (J).Curscop); Push_Scope (Delay_Check.Table (J).Curscop);
From_Elab_Code := Delay_Check.Table (J).From_Elab_Code; From_Elab_Code := Delay_Check.Table (J).From_Elab_Code;
In_Task_Activation := Delay_Check.Table (J).In_Task_Activation;
-- Set appropriate value of SPARK_Mode -- Set appropriate value of SPARK_Mode
@ -1965,11 +1974,11 @@ package body Sem_Elab is
SPARK_Mode := On; SPARK_Mode := On;
end if; end if;
Check_Internal_Call_Continue ( Check_Internal_Call_Continue
N => Delay_Check.Table (J).N, (N => Delay_Check.Table (J).N,
E => Delay_Check.Table (J).E, E => Delay_Check.Table (J).E,
Outer_Scope => Delay_Check.Table (J).Outer_Scope, Outer_Scope => Delay_Check.Table (J).Outer_Scope,
Orig_Ent => Delay_Check.Table (J).Orig_Ent); Orig_Ent => Delay_Check.Table (J).Orig_Ent);
SPARK_Mode := Save_SPARK_Mode; SPARK_Mode := Save_SPARK_Mode;
Pop_Scope; Pop_Scope;
@ -2201,12 +2210,6 @@ package body Sem_Elab is
elsif Is_Intrinsic_Subprogram (E) then elsif Is_Intrinsic_Subprogram (E) then
return; return;
-- No need to trace local calls if checking task activation, because
-- other local bodies are elaborated already.
elsif In_Task_Activation then
return;
-- Nothing to do if call is within a generic unit -- Nothing to do if call is within a generic unit
elsif Inside_A_Generic then elsif Inside_A_Generic then
@ -2224,14 +2227,15 @@ package body Sem_Elab is
-- Delay this call if we are still delaying calls -- Delay this call if we are still delaying calls
if Delaying_Elab_Checks then if Delaying_Elab_Checks then
Delay_Check.Append ( Delay_Check.Append
(N => N, ((N => N,
E => E, E => E,
Orig_Ent => Orig_Ent, Orig_Ent => Orig_Ent,
Curscop => Current_Scope, Curscop => Current_Scope,
Outer_Scope => Outer_Scope, Outer_Scope => Outer_Scope,
From_Elab_Code => From_Elab_Code, From_Elab_Code => From_Elab_Code,
From_SPARK_Code => SPARK_Mode = On)); In_Task_Activation => In_Task_Activation,
From_SPARK_Code => SPARK_Mode = On));
return; return;
-- Otherwise, call phase 2 continuation right now -- Otherwise, call phase 2 continuation right now
@ -2520,7 +2524,10 @@ package body Sem_Elab is
-- inserted. -- inserted.
begin begin
if Inst_Case then if In_Task_Activation then
Insert_Check := False;
elsif Inst_Case then
Error_Msg_NE Error_Msg_NE
("cannot instantiate& before body seen<<", N, Orig_Ent); ("cannot instantiate& before body seen<<", N, Orig_Ent);

4
gcc/ada/sem_elab.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1997-2015, Free Software Foundation, Inc. -- -- Copyright (C) 1997-2017, 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- --
@ -132,7 +132,7 @@ package Sem_Elab is
-- N_Function_Call or N_Procedure_Call_Statement node or an access -- N_Function_Call or N_Procedure_Call_Statement node or an access
-- attribute reference whose prefix is a subprogram. -- attribute reference whose prefix is a subprogram.
-- --
-- If SPARK_Mode is On, then N can also be a variablr reference, since -- If SPARK_Mode is On, then N can also be a variable reference, since
-- SPARK requires the use of Elaborate_All for references to variables -- SPARK requires the use of Elaborate_All for references to variables
-- in other packages. -- in other packages.

19
gcc/ada/sem_prag.adb
View File

@ -12756,22 +12756,9 @@ package body Sem_Prag is
-- Deal with SCO generation -- Deal with SCO generation
case Cname is if Is_Checked (N) and then not Split_PPC (N) then
Set_SCO_Pragma_Enabled (Loc);
-- Nothing to do for predicates as the checks occur in the end if;
-- client units. The SCO for the aspect in the declaration
-- unit is conservatively always enabled.
when Name_Predicate =>
null;
-- Otherwise mark aspect/pragma SCO as enabled
when others =>
if Is_Checked (N) and then not Split_PPC (N) then
Set_SCO_Pragma_Enabled (Loc);
end if;
end case;
-- Deal with analyzing the string argument -- Deal with analyzing the string argument

29
gcc/ada/sem_warn.adb
View File

@ -3267,22 +3267,39 @@ package body Sem_Warn is
-------------------------------------- --------------------------------------
procedure Warn_On_Constant_Valid_Condition (Op : Node_Id) is procedure Warn_On_Constant_Valid_Condition (Op : Node_Id) is
Left : constant Node_Id := Left_Opnd (Op);
Right : constant Node_Id := Right_Opnd (Op);
True_Result : Boolean; True_Result : Boolean;
False_Result : Boolean; False_Result : Boolean;
begin begin
-- Determine the potential outcome of the comparison assuming that the -- Determine the potential outcome of the comparison assuming that the
-- operands are valid. Do not consider instances because the check was -- operands are valid.
-- already performed in the generic. Do not consider comparison between
-- an attribute reference and a compile-time known value since this is
-- most likely a conditional compilation. Do not consider internal files
-- in order to allow for various assertions and safeguards within our
-- runtime.
if Constant_Condition_Warnings if Constant_Condition_Warnings
and then Comes_From_Source (Original_Node (Op)) and then Comes_From_Source (Original_Node (Op))
-- Do not consider instances because the check was already performed
-- in the generic.
and then not In_Instance and then not In_Instance
-- Do not consider comparisons between two static expressions such as
-- constants or literals because those values cannot be invalidated.
and then not (Is_Static_Expression (Left)
and then Is_Static_Expression (Right))
-- Do not consider comparison between an attribute reference and a
-- compile-time known value since this is most likely a conditional
-- compilation.
and then not Is_Attribute_And_Known_Value_Comparison (Op) and then not Is_Attribute_And_Known_Value_Comparison (Op)
-- Do not consider internal files to allow for various assertions and
-- safeguards within our runtime.
and then not Is_Internal_File_Name and then not Is_Internal_File_Name
(Unit_File_Name (Get_Source_Unit (Op))) (Unit_File_Name (Get_Source_Unit (Op)))
then then

14
gcc/ada/urealp.adb
View File

@ -493,14 +493,7 @@ package body Urealp is
procedure Tree_Read is procedure Tree_Read is
begin begin
-- Disable the warnings emitted by -gnatwc because the following check
-- acts as a signal in case Num_Ureal_Constants is changed.
pragma Warnings
(Off, "condition can only be * if invalid values present");
pragma Assert (Num_Ureal_Constants = 10); pragma Assert (Num_Ureal_Constants = 10);
pragma Warnings
(On, "condition can only be * if invalid values present");
Ureals.Tree_Read; Ureals.Tree_Read;
Tree_Read_Int (Int (UR_0)); Tree_Read_Int (Int (UR_0));
@ -525,14 +518,7 @@ package body Urealp is
procedure Tree_Write is procedure Tree_Write is
begin begin
-- Disable the warnings emitted by -gnatwc because the following check
-- acts as a signal in case Num_Ureal_Constants is changed.
pragma Warnings
(Off, "condition can only be * if invalid values present");
pragma Assert (Num_Ureal_Constants = 10); pragma Assert (Num_Ureal_Constants = 10);
pragma Warnings
(On, "condition can only be * if invalid values present");
Ureals.Tree_Write; Ureals.Tree_Write;
Tree_Write_Int (Int (UR_0)); Tree_Write_Int (Int (UR_0));

7
gcc/ada/usage.adb
View File

@ -671,11 +671,6 @@ begin
Write_Switch_Char ("zr"); Write_Switch_Char ("zr");
Write_Line ("Distribution stub generation for receiver stubs"); Write_Line ("Distribution stub generation for receiver stubs");
-- Disable the warnings emitted by -gnatwc because Ada_Version_Default may
-- be changed to denote a different default value.
pragma Warnings (Off, "condition can only be * if invalid values present");
if not Latest_Ada_Only then if not Latest_Ada_Only then
-- Line for -gnat83 switch -- Line for -gnat83 switch
@ -714,8 +709,6 @@ begin
Write_Line ("Ada 2012 mode"); Write_Line ("Ada 2012 mode");
end if; end if;
pragma Warnings (On, "condition can only be * if invalid values present");
-- Line for -gnat-p switch -- Line for -gnat-p switch
Write_Switch_Char ("-p"); Write_Switch_Char ("-p");