diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2020-02-05 18:02:03 +0100 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-05 08:17:51 -0400 |
commit | 32115be843e3d7bd344b1e899deee27aef9a3b65 (patch) | |
tree | c1e21353c59aaa1abbf792e0e289ebba6579525b /gcc | |
parent | 0ad46f04488199557f2b407f8d10839ef5c6e604 (diff) | |
download | gcc-32115be843e3d7bd344b1e899deee27aef9a3b65.zip gcc-32115be843e3d7bd344b1e899deee27aef9a3b65.tar.gz gcc-32115be843e3d7bd344b1e899deee27aef9a3b65.tar.bz2 |
[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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/atree.adb | 6 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 12 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 12 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 34 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.ads | 3 |
5 files changed, 45 insertions, 22 deletions
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 5619f09..d7686fa 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -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. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index bd9c6ad..744c8a4 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 1b1448c..a977e4f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9523493..3c65a34 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 55e3890..1d1d983 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -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 |