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

[Ada] Make the Has_Dynamic_Range_Check flag obsolete 

2020-06-05  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* atree.adb (New_Copy): Clear Has_Dynamic_Range_Check on
	subexpression nodes.
	* checks.adb (Append_Range_Checks): Assert that the node
	doesn't have the Has_Dynamic_Range_Check flag set.
	(Insert_Range_Checks): Likewise.
	* exp_ch3.adb (Expand_N_Subtype_Indication): Do not apply
	range checks for a full type or object declaration.
	* sem_ch3.ads: Move with and use clauses for Nlists to...
	(Process_Range_Expr_In_Decl): Change default to No_List for
	the Check_List parameter.
	* sem_ch3.adb: ...here.
	(Process_Range_Expr_In_Decl): Likewise.  When the insertion
	node is a declaration, only insert on the list if is present
	when the declaration involves discriminants, and only insert
	on the node when there is no list otherwise.
This commit is contained in:
Eric Botcazou 2020-02-05 18:02:03 +01:00 committed by Pierre-Marie de Rodat
parent 0ad46f0448
commit 32115be843
5 changed files with 45 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/atree.adb
View File

@ -1659,6 +1659,12 @@ package body Atree is
Nodes.Table (New_Id).Rewrite_Ins := False;
pragma Debug (New_Node_Debugging_Output (New_Id));
-- Clear Has_Dynamic_Range_Check since it doesn't apply anymore
if Nkind (Source) in N_Subexpr then
Set_Has_Dynamic_Range_Check (New_Id, False);
end if;
-- Clear Is_Overloaded since we cannot have semantic interpretations
-- of this new node.

12
gcc/ada/checks.adb
View File

@ -514,7 +514,11 @@ package body Checks is
if Nkind (Checks (J)) = N_Raise_Constraint_Error
and then Present (Condition (Checks (J)))
then
if not Has_Dynamic_Range_Check (Internal_Flag_Node) then
if Has_Dynamic_Range_Check (Internal_Flag_Node) then
pragma Assert (False);
null;
else
Append_To (Stmts, Checks (J));
Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
end if;
@ -7470,7 +7474,11 @@ package body Checks is
if Nkind (Checks (J)) = N_Raise_Constraint_Error
and then Present (Condition (Checks (J)))
then
if not Has_Dynamic_Range_Check (Internal_Flag_Node) then
if Has_Dynamic_Range_Check (Internal_Flag_Node) then
pragma Assert (False);
null;
else
Check_Node := Checks (J);
Mark_Rewrite_Insertion (Check_Node);

12
gcc/ada/exp_ch3.adb
View File

@ -7294,10 +7294,7 @@ package body Exp_Ch3 is
-- Expand_N_Subtype_Indication --
---------------------------------
-- Add a check on the range of the subtype. The static case is partially
-- duplicated by Process_Range_Expr_In_Decl in Sem_Ch3, but we still need
-- to check here for the static case in order to avoid generating
-- extraneous expanded code. Also deal with validity checking.
-- Add a check on the range of the subtype and deal with validity checking
procedure Expand_N_Subtype_Indication (N : Node_Id) is
Ran : constant Node_Id := Range_Expression (Constraint (N));
@ -7308,7 +7305,12 @@ package body Exp_Ch3 is
Validity_Check_Range (Range_Expression (Constraint (N)));
end if;
if Nkind_In (Parent (N), N_Constrained_Array_Definition, N_Slice) then
-- Do not duplicate the work of Process_Range_Expr_In_Decl in Sem_Ch3
if Nkind_In (Parent (N), N_Constrained_Array_Definition, N_Slice)
and then Nkind (Parent (Parent (N))) /= N_Full_Type_Declaration
and then Nkind (Parent (Parent (N))) /= N_Object_Declaration
then
Apply_Range_Check (Ran, Typ);
end if;
end Expand_N_Subtype_Indication;

34
gcc/ada/sem_ch3.adb
View File

@ -45,6 +45,7 @@ with Layout; use Layout;
with Lib; use Lib;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
@ -21214,7 +21215,7 @@ package body Sem_Ch3 is
(R : Node_Id;
T : Entity_Id;
Subtyp : Entity_Id := Empty;
Check_List : List_Id := Empty_List;
Check_List : List_Id := No_List;
R_Check_Off : Boolean := False;
In_Iter_Schm : Boolean := False)
is
@ -21435,9 +21436,13 @@ package body Sem_Ch3 is
end if;
end;
-- Insertion before a declaration. If the declaration
-- includes discriminants, the list of applicable checks
-- is given by the caller.
-- Case of declarations. If the declaration is for a type
-- and involves discriminants, the checks are premature at
-- the declaration point and need to wait for the expansion
-- of the initialization procedure, which will pass in the
-- list to put them on; otherwise, the checks are done at
-- the declaration point and there is no need to do them
-- again in the initialization procedure.
elsif Nkind (Insert_Node) in N_Declaration then
Def_Id := Defining_Identifier (Insert_Node);
@ -21448,19 +21453,22 @@ package body Sem_Ch3 is
(Ekind (Def_Id) = E_Protected_Type
and then Has_Discriminants (Def_Id))
then
Append_Range_Checks
(R_Checks,
Check_List, Def_Id, Sloc (Insert_Node), R);
if Present (Check_List) then
Append_Range_Checks
(R_Checks,
Check_List, Def_Id, Sloc (Insert_Node), R);
end if;
else
Insert_Range_Checks
(R_Checks,
Insert_Node, Def_Id, Sloc (Insert_Node), R);
if No (Check_List) then
Insert_Range_Checks
(R_Checks,
Insert_Node, Def_Id, Sloc (Insert_Node), R);
end if;
end if;
-- Insertion before a statement. Range appears in the
-- context of a quantified expression. Insertion will
-- Case of statements. Drop the checks, as the range appears
-- in the context of a quantified expression. Insertion will
-- take place when expression is expanded.
else

3
gcc/ada/sem_ch3.ads
View File

@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
with Nlists; use Nlists;
with Types; use Types;
package Sem_Ch3 is
@ -265,7 +264,7 @@ package Sem_Ch3 is
(R : Node_Id;
T : Entity_Id;
Subtyp : Entity_Id := Empty;
Check_List : List_Id := Empty_List;
Check_List : List_Id := No_List;
R_Check_Off : Boolean := False;
In_Iter_Schm : Boolean := False);
-- Process a range expression that appears in a declaration context. The