diff options
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 |