+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>
* sem_prag.adb, sem_warn.adb, sem_eval.adb: Minor reformatting and
Write_Eol;
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_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
begin
Max_Chain_Length := C;
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
Write_Str ("Hash_Table (");
Write_Int (J);
N := Name_Entries.Table (N).Hash_Link;
end loop;
end if;
-
- pragma Warnings
- (On, "condition can only be * if invalid values present");
end;
end if;
end loop;
Indentation_Limit : constant Positive := 40;
-- 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 Warnings (On, "condition can only be * if invalid values present");
-- Make sure this is substantially shorter than the line length
Cur_Indentation : Natural := 0;
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Aspects rewritten into pragmas controlled by a Check_Policy:
-- Current_Pragma_Sloc must be set to the sloc of the aspect
-- 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
| Aspect_Post
| Aspect_Pre
| Aspect_Precondition
| Aspect_Type_Invariant
- =>
- 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_Dynamic_Predicate
| Aspect_Predicate
| Aspect_Static_Predicate
=>
- C1 := 'A';
+ C1 := 'a';
-- Other aspects: just process any decision nested in the
-- aspect expression.
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
+with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
-- Start of processing for Add_Predicate
begin
+ -- Mark corresponding SCO as enabled
+
+ Set_SCO_Pragma_Enabled (Sloc (Prag));
+
-- Extract the arguments of the pragma. The expression itself
-- is copied for use in the predicate function, to preserve the
-- original version for ASIS use.
Ent : Entity_Id;
end record;
- package Elab_Call is new Table.Table (
- Table_Component_Type => Elab_Call_Entry,
- Table_Index_Type => Int,
- Table_Low_Bound => 1,
- Table_Initial => 50,
- Table_Increment => 100,
- Table_Name => "Elab_Call");
+ package Elab_Call is new Table.Table
+ (Table_Component_Type => Elab_Call_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 100,
+ Table_Name => "Elab_Call");
-- 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
-- particular outer level call, and is used to prevent both infinite
-- recursion, and useless reanalysis of bodies already seen
- package Elab_Visited is new Table.Table (
- Table_Component_Type => Entity_Id,
- Table_Index_Type => Int,
- Table_Low_Bound => 1,
- Table_Initial => 200,
- Table_Increment => 100,
- Table_Name => "Elab_Visited");
+ package Elab_Visited is new Table.Table
+ (Table_Component_Type => Entity_Id,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 200,
+ Table_Increment => 100,
+ Table_Name => "Elab_Visited");
-- This table stores calls to Check_Internal_Call that are delayed until
-- all generics are instantiated and in particular until after all generic
-- The current scope of the call. This is restored when we complete the
-- delayed call, so that we do this in the right scope.
- From_SPARK_Code : Boolean;
- -- Save indication of whether this call is under SPARK_Mode => On
+ Outer_Scope : Entity_Id;
+ -- Save scope of outer level call
From_Elab_Code : Boolean;
-- Save indication of whether this call is from elaboration code
- Outer_Scope : Entity_Id;
- -- Save scope of outer level call
+ In_Task_Activation : Boolean;
+ -- 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;
- package Delay_Check is new Table.Table (
- Table_Component_Type => Delay_Element,
- Table_Index_Type => Int,
- Table_Low_Bound => 1,
- Table_Initial => 1000,
- Table_Increment => 100,
- Table_Name => "Delay_Check");
+ package Delay_Check is new Table.Table
+ (Table_Component_Type => Delay_Element,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 1000,
+ Table_Increment => 100,
+ Table_Name => "Delay_Check");
C_Scope : Entity_Id;
-- Top-level scope of current scope. Compute this only once at the outer
-- routines in other units if this flag is True.
In_Task_Activation : Boolean := False;
- -- This flag indicates whether we are performing elaboration checks on
- -- task procedures, at the point of activation. If true, we do not trace
- -- internal calls in these procedures, because all local bodies are known
- -- to be elaborated.
+ -- This flag indicates whether we are performing elaboration checks on task
+ -- bodies, at the point of activation. If true, we do not raise
+ -- Program_Error for calls to local procedures, because all local bodies
+ -- 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;
-- This is set True till the compilation is complete, including the
Orig_Ent : Entity_Id);
-- The processing for Check_Internal_Call is divided up into two phases,
-- 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
-- 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
for J in Delay_Check.First .. Delay_Check.Last loop
Push_Scope (Delay_Check.Table (J).Curscop);
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
SPARK_Mode := On;
end if;
- Check_Internal_Call_Continue (
- N => Delay_Check.Table (J).N,
- E => Delay_Check.Table (J).E,
- Outer_Scope => Delay_Check.Table (J).Outer_Scope,
- Orig_Ent => Delay_Check.Table (J).Orig_Ent);
+ Check_Internal_Call_Continue
+ (N => Delay_Check.Table (J).N,
+ E => Delay_Check.Table (J).E,
+ Outer_Scope => Delay_Check.Table (J).Outer_Scope,
+ Orig_Ent => Delay_Check.Table (J).Orig_Ent);
SPARK_Mode := Save_SPARK_Mode;
Pop_Scope;
elsif Is_Intrinsic_Subprogram (E) then
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
elsif Inside_A_Generic then
-- Delay this call if we are still delaying calls
if Delaying_Elab_Checks then
- Delay_Check.Append (
- (N => N,
- E => E,
- Orig_Ent => Orig_Ent,
- Curscop => Current_Scope,
- Outer_Scope => Outer_Scope,
- From_Elab_Code => From_Elab_Code,
- From_SPARK_Code => SPARK_Mode = On));
+ Delay_Check.Append
+ ((N => N,
+ E => E,
+ Orig_Ent => Orig_Ent,
+ Curscop => Current_Scope,
+ Outer_Scope => Outer_Scope,
+ From_Elab_Code => From_Elab_Code,
+ In_Task_Activation => In_Task_Activation,
+ From_SPARK_Code => SPARK_Mode = On));
return;
-- Otherwise, call phase 2 continuation right now
-- inserted.
begin
- if Inst_Case then
+ if In_Task_Activation then
+ Insert_Check := False;
+
+ elsif Inst_Case then
Error_Msg_NE
("cannot instantiate& before body seen<<", N, Orig_Ent);
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- N_Function_Call or N_Procedure_Call_Statement node or an access
-- 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
-- in other packages.
-- Deal with SCO generation
- case Cname is
-
- -- Nothing to do for predicates as the checks occur in the
- -- 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;
+ if Is_Checked (N) and then not Split_PPC (N) then
+ Set_SCO_Pragma_Enabled (Loc);
+ end if;
-- Deal with analyzing the string argument
--------------------------------------
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;
False_Result : Boolean;
begin
-- Determine the potential outcome of the comparison assuming that the
- -- operands are valid. Do not consider instances because the check was
- -- 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.
+ -- operands are valid.
if Constant_Condition_Warnings
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
+
+ -- 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)
+
+ -- Do not consider internal files to allow for various assertions and
+ -- safeguards within our runtime.
+
and then not Is_Internal_File_Name
(Unit_File_Name (Get_Source_Unit (Op)))
then
procedure Tree_Read is
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 Warnings
- (On, "condition can only be * if invalid values present");
Ureals.Tree_Read;
Tree_Read_Int (Int (UR_0));
procedure Tree_Write is
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 Warnings
- (On, "condition can only be * if invalid values present");
Ureals.Tree_Write;
Tree_Write_Int (Int (UR_0));
Write_Switch_Char ("zr");
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
-- Line for -gnat83 switch
Write_Line ("Ada 2012 mode");
end if;
- pragma Warnings (On, "condition can only be * if invalid values present");
-
-- Line for -gnat-p switch
Write_Switch_Char ("-p");
projects / gcc.git / commitdiff