[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.

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 5619f09046f8795a7991109b2f4b3d5f0cfee657..d7686fa5868e1a40fd1c5de495ea9aba28753bfe 100644 (file)
--- 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 bd9c6adab81262251b7cddfa2a7f4ab2fe835cfc..744c8a41e338e1e25e0d17b0c4786a36ce050ea7 100644 (file)
--- 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 1b1448c6d388effcd9dc74e61694e3d6602f9fb7..a977e4f8e7b052150d477999aa78fb7b86acb3a7 100644 (file)
--- 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 9523493b55be86251304ea3bd5e991b192fc5d7b..3c65a340ff1ba4774eafdabb64b128a21a027856 100644 (file)
--- 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 55e38909754fddffeeba53c4e6284369f70ddfbe..1d1d983b6e2a4dadc7cb35fec77955a22e021322 100644 (file)
--- 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