[Ada] Remove the Has_Dynamic_Range_Check flag

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

gcc/ada/

	* atree.adb (New_Copy): Do not clear Has_Dynamic_Range_Check.
	* checks.ads (Append_Range_Checks): Remove Flag_Node parameter.
	(Insert_Range_Checks): Likewise and remove default value of
	Static_Loc parameter.
	* checks.adb (Append_Range_Checks): Remove Flag_Node parameter.
	Do not test and set Has_Dynamic_Range_Check.
	(Insert_Range_Checks): Likewise and remove default value of
	Static_Loc parameter.
	* csinfo.adb (CSinfo): Remove 'L' from [NEUB]_Fields pattern and
	do not handle Has_Dynamic_Range_Check.
	* exp_ch5.adb (Expand_N_Assignment_Statement): Remove argument
	in call to Insert_Range_Checks.
	* sem_ch3.adb (Analyze_Subtype_Declaration): Do not fiddle
	with Has_Dynamic_Range_Check.
	(Process_Range_Expr_In_Decl): Remove argument in calls to
	Insert_Range_Checks and Append_Range_Checks.
	* sinfo.ads (Has_Dynamic_Range_Check): Delete.
	(Set_Has_Dynamic_Range_Check): Likewise.
	* sinfo.adb (Has_Dynamic_Range_Check): Delete.
	(Set_Has_Dynamic_Range_Check): Likewise.
	* treepr.adb (Print_Node): Do not print Has_Dynamic_Range_Check.

9 files changed, 28 insertions, 150 deletions

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index d7686fa..5619f09 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -1659,12 +1659,6 @@ 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 945c7d3..eb62b2b 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -488,17 +488,13 @@ package body Checks is
      (Checks       : Check_Result;
       Stmts        : List_Id;
       Suppress_Typ : Entity_Id;
-      Static_Sloc  : Source_Ptr;
-      Flag_Node    : Node_Id)
+      Static_Sloc  : Source_Ptr)
    is
       Checks_On : constant Boolean :=
                     not Index_Checks_Suppressed (Suppress_Typ)
                       or else
                     not Range_Checks_Suppressed (Suppress_Typ);
 
-      Internal_Flag_Node   : constant Node_Id    := Flag_Node;
-      Internal_Static_Sloc : constant Source_Ptr := Static_Sloc;
-
    begin
       --  For now we just return if Checks_On is false, however this should be
       --  enhanced to check for an always True value in the condition and to
@@ -514,19 +510,11 @@ package body Checks is
          if Nkind (Checks (J)) = N_Raise_Constraint_Error
            and then Present (Condition (Checks (J)))
          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;
-
+            Append_To (Stmts, Checks (J));
          else
             Append_To
               (Stmts,
-                Make_Raise_Constraint_Error (Internal_Static_Sloc,
+                Make_Raise_Constraint_Error (Static_Sloc,
                   Reason => CE_Range_Check_Failed));
          end if;
       end loop;
@@ -3440,14 +3428,6 @@ package body Checks is
 
             Insert_Action (Expr, R_Cno);
 
-            --  This old code doesn't make sense, why is the context flagged as
-            --  requiring dynamic range checks now in the middle of generating
-            --  them ???
-
-            if not Do_Static then
-               Set_Has_Dynamic_Range_Check (Expr);
-            end if;
-
             --  The triggering condition evaluates to True, the range check
             --  can be converted into a compile time constraint check.
 
@@ -7444,8 +7424,7 @@ package body Checks is
      (Checks       : Check_Result;
       Node         : Node_Id;
       Suppress_Typ : Entity_Id;
-      Static_Sloc  : Source_Ptr := No_Location;
-      Flag_Node    : Node_Id    := Empty;
+      Static_Sloc  : Source_Ptr;
       Do_Before    : Boolean    := False)
    is
       Checks_On  : constant Boolean :=
@@ -7453,9 +7432,7 @@ package body Checks is
                        or else
                      not Range_Checks_Suppressed (Suppress_Typ);
 
-      Check_Node           : Node_Id;
-      Internal_Flag_Node   : Node_Id    := Flag_Node;
-      Internal_Static_Sloc : Source_Ptr := Static_Sloc;
+      Check_Node : Node_Id;
 
    begin
       --  For now we just return if Checks_On is false, however this should be
@@ -7466,48 +7443,25 @@ package body Checks is
          return;
       end if;
 
-      if Static_Sloc = No_Location then
-         Internal_Static_Sloc := Sloc (Node);
-      end if;
-
-      if No (Flag_Node) then
-         Internal_Flag_Node := Node;
-      end if;
-
       for J in 1 .. 2 loop
          exit when No (Checks (J));
 
          if Nkind (Checks (J)) = N_Raise_Constraint_Error
            and then Present (Condition (Checks (J)))
          then
-            if Has_Dynamic_Range_Check (Internal_Flag_Node) then
-               pragma Assert (False);
-               null;
-
-            else
-               Check_Node := Checks (J);
-               Mark_Rewrite_Insertion (Check_Node);
-
-               if Do_Before then
-                  Insert_Before_And_Analyze (Node, Check_Node);
-               else
-                  Insert_After_And_Analyze (Node, Check_Node);
-               end if;
-
-               Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
-            end if;
-
+            Check_Node := Checks (J);
          else
             Check_Node :=
-              Make_Raise_Constraint_Error (Internal_Static_Sloc,
+              Make_Raise_Constraint_Error (Static_Sloc,
                 Reason => CE_Range_Check_Failed);
-            Mark_Rewrite_Insertion (Check_Node);
+         end if;
 
-            if Do_Before then
-               Insert_Before_And_Analyze (Node, Check_Node);
-            else
-               Insert_After_And_Analyze (Node, Check_Node);
-            end if;
+         Mark_Rewrite_Insertion (Check_Node);
+
+         if Do_Before then
+            Insert_Before_And_Analyze (Node, Check_Node);
+         else
+            Insert_After_And_Analyze (Node, Check_Node);
          end if;
       end loop;
    end Insert_Range_Checks;
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index eeb7720..6412686 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -637,32 +637,25 @@ package Checks is
      (Checks       : Check_Result;
       Stmts        : List_Id;
       Suppress_Typ : Entity_Id;
-      Static_Sloc  : Source_Ptr;
-      Flag_Node    : Node_Id);
+      Static_Sloc  : Source_Ptr);
    --  Called to append range checks as returned by a call to Get_Range_Checks.
    --  Stmts is a list to which either the dynamic check is appended or the
    --  raise Constraint_Error statement is appended (for static checks).
-   --  Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
-   --  used as the node at which to set the Has_Dynamic_Check flag. Checks_On
-   --  is a boolean value that says if range and index checking is on or not.
+   --  Suppress_Typ is the type to check to determine if checks are suppressed.
+   --  Static_Sloc is the Sloc at which the raise CE node points.
 
    procedure Insert_Range_Checks
      (Checks       : Check_Result;
       Node         : Node_Id;
       Suppress_Typ : Entity_Id;
-      Static_Sloc  : Source_Ptr := No_Location;
-      Flag_Node    : Node_Id    := Empty;
-      Do_Before    : Boolean    := False);
+      Static_Sloc  : Source_Ptr;
+      Do_Before    : Boolean := False);
    --  Called to insert range checks as returned by a call to Get_Range_Checks.
    --  Node is the node after which either the dynamic check is inserted or
    --  the raise Constraint_Error statement is inserted (for static checks).
    --  Suppress_Typ is the type to check to determine if checks are suppressed.
-   --  Static_Sloc, if passed, is the Sloc at which the raise CE node points,
-   --  otherwise Sloc (Node) is used. The Has_Dynamic_Check flag is normally
-   --  set at Node. If Flag_Node is present, then this is used instead as the
-   --  node at which to set the Has_Dynamic_Check flag. Normally the check is
-   --  inserted after, if Do_Before is True, the check is inserted before
-   --  Node.
+   --  Static_Sloc is the Sloc at which the raise CE node points. Normally the
+   --  checks are inserted after Node; if Do_Before is True, they are before.
 
    -----------------------
    -- Expander Routines --
diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb
index 3473704..635a2a5 100644
--- a/gcc/ada/csinfo.adb
+++ b/gcc/ada/csinfo.adb
@@ -89,10 +89,10 @@ procedure CSinfo is
    Flags : TV.Table (20);
    --  Maps flag numbers to letters
 
-   N_Fields : constant Pattern := BreakX ("JL");
-   E_Fields : constant Pattern := BreakX ("5EFGHIJLOP");
-   U_Fields : constant Pattern := BreakX ("1345EFGHIJKLOPQ");
-   B_Fields : constant Pattern := BreakX ("12345EFGHIJKLOPQ");
+   N_Fields : constant Pattern := BreakX ("J");
+   E_Fields : constant Pattern := BreakX ("5EFGHIJOP");
+   U_Fields : constant Pattern := BreakX ("1345EFGHIJKOPQ");
+   B_Fields : constant Pattern := BreakX ("12345EFGHIJKOPQ");
 
    Line : VString;
    Bad  : Boolean;
@@ -215,7 +215,6 @@ begin
    Set (Special, "First_Itype",                      True);
    Set (Special, "Has_Aspect_Specifications",        True);
    Set (Special, "Has_Dynamic_Itype",                True);
-   Set (Special, "Has_Dynamic_Range_Check",          True);
    Set (Special, "Has_Dynamic_Length_Check",         True);
    Set (Special, "Has_Private_View",                 True);
    Set (Special, "Is_Controlling_Actual",            True);
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index e565738..d69e147 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2465,8 +2465,7 @@ package body Exp_Ch5 is
                     (C_Es,
                      N,
                      Target_Typ,
-                     Sloc (Lhs),
-                     Lhs);
+                     Sloc (Lhs));
                end;
             end if;
          end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9cd1b35..c9dac2c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5768,7 +5768,6 @@ package body Sem_Ch3 is
                Target_Index : Node_Id :=
                                 First_Index (Etype
                                   (Subtype_Mark (Subtype_Indication (N))));
-               Has_Dyn_Chk  : Boolean := Has_Dynamic_Range_Check (N);
 
             begin
                while Present (Subt_Index) loop
@@ -5789,34 +5788,17 @@ package body Sem_Ch3 is
                              Etype (Subt_Index),
                              Defining_Identifier (N));
 
-                        --  Reset Has_Dynamic_Range_Check on the subtype to
-                        --  prevent elision of the index check due to a dynamic
-                        --  check generated for a preceding index (needed since
-                        --  Insert_Range_Checks tries to avoid generating
-                        --  redundant checks on a given declaration).
-
-                        Set_Has_Dynamic_Range_Check (N, False);
-
                         Insert_Range_Checks
                           (R_Checks,
                            N,
                            Target_Typ,
                            Sloc (Defining_Identifier (N)));
-
-                        --  Record whether this index involved a dynamic check
-
-                        Has_Dyn_Chk :=
-                          Has_Dyn_Chk or else Has_Dynamic_Range_Check (N);
                      end;
                   end if;
 
                   Next_Index (Subt_Index);
                   Next_Index (Target_Index);
                end loop;
-
-               --  Finally, mark whether the subtype involves dynamic checks
-
-               Set_Has_Dynamic_Range_Check (N, Has_Dyn_Chk);
             end;
          end if;
       end if;
@@ -21233,7 +21215,6 @@ package body Sem_Ch3 is
                               Insert_Node,
                               Def_Id,
                               Sloc (Insert_Node),
-                              R,
                               Do_Before => True);
                         end if;
                      end;
@@ -21258,14 +21239,14 @@ package body Sem_Ch3 is
                         if Present (Check_List) then
                            Append_Range_Checks
                              (R_Checks,
-                               Check_List, Def_Id, Sloc (Insert_Node), R);
+                               Check_List, Def_Id, Sloc (Insert_Node));
                         end if;
 
                      else
                         if No (Check_List) then
                            Insert_Range_Checks
                              (R_Checks,
-                               Insert_Node, Def_Id, Sloc (Insert_Node), R);
+                               Insert_Node, Def_Id, Sloc (Insert_Node));
                         end if;
                      end if;
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 687d2fe..f6e70c1 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1523,15 +1523,6 @@ package body Sinfo is
       return Flag10 (N);
    end Has_Dynamic_Length_Check;
 
-   function Has_Dynamic_Range_Check
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind =  N_Subtype_Declaration
-        or else NT (N).Nkind in N_Subexpr);
-      return Flag12 (N);
-   end Has_Dynamic_Range_Check;
-
    function Has_Init_Expression
       (N : Node_Id) return Boolean is
    begin
@@ -4997,15 +4988,6 @@ package body Sinfo is
       Set_Flag10 (N, Val);
    end Set_Has_Dynamic_Length_Check;
 
-   procedure Set_Has_Dynamic_Range_Check
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind =  N_Subtype_Declaration
-        or else NT (N).Nkind in N_Subexpr);
-      Set_Flag12 (N, Val);
-   end Set_Has_Dynamic_Range_Check;
-
    procedure Set_Has_Init_Expression
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 203bbd4..ea4f8ed 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -425,7 +425,6 @@ package Sinfo is
    --       Must_Not_Freeze          (Flag8-Sem)  set if must not freeze
    --       Do_Range_Check           (Flag9-Sem)  set if a range check needed
    --       Has_Dynamic_Length_Check (Flag10-Sem) set if length check inserted
-   --       Has_Dynamic_Range_Check  (Flag12-Sem) set if range check inserted
    --       Assignment_OK            (Flag15-Sem) set if modification is OK
    --       Is_Controlling_Actual    (Flag16-Sem) set for controlling argument
 
@@ -1456,14 +1455,6 @@ package Sinfo is
    --    action which has been inserted at the flagged node. This is used to
    --    avoid the generation of duplicate checks.
 
-   --  Has_Dynamic_Range_Check (Flag12-Sem)
-   --    This flag is present in N_Subtype_Declaration nodes and on all
-   --    expression nodes. It is set to indicate that one of the routines in
-   --    unit Checks has generated a range check action which has been inserted
-   --    at the flagged node. This is used to avoid the generation of duplicate
-   --    checks. Why does this occur on N_Subtype_Declaration nodes, what does
-   --    it mean in that context???
-
    --  Has_Local_Raise (Flag8-Sem)
    --    Present in exception handler nodes. Set if the handler can be entered
    --    via a local raise that gets transformed to a goto statement. This will
@@ -2866,7 +2857,6 @@ package Sinfo is
       --  Subtype_Indication (Node5)
       --  Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
       --  Exception_Junk (Flag8-Sem)
-      --  Has_Dynamic_Range_Check (Flag12-Sem)
 
       -------------------------------
       -- 3.2.2  Subtype Indication --
@@ -9588,9 +9578,6 @@ package Sinfo is
    function Has_Dynamic_Length_Check
      (N : Node_Id) return Boolean;    -- Flag10
 
-   function Has_Dynamic_Range_Check
-     (N : Node_Id) return Boolean;    -- Flag12
-
    function Has_Init_Expression
      (N : Node_Id) return Boolean;    -- Flag14
 
@@ -10694,9 +10681,6 @@ package Sinfo is
    procedure Set_Has_Dynamic_Length_Check
      (N : Node_Id; Val : Boolean := True);    -- Flag10
 
-   procedure Set_Has_Dynamic_Range_Check
-     (N : Node_Id; Val : Boolean := True);    -- Flag12
-
    procedure Set_Has_Init_Expression
      (N : Node_Id; Val : Boolean := True);    -- Flag14
 
@@ -13347,7 +13331,6 @@ package Sinfo is
    pragma Inline (Has_Created_Identifier);
    pragma Inline (Has_Dereference_Action);
    pragma Inline (Has_Dynamic_Length_Check);
-   pragma Inline (Has_Dynamic_Range_Check);
    pragma Inline (Has_Init_Expression);
    pragma Inline (Has_Local_Raise);
    pragma Inline (Has_Self_Reference);
@@ -13712,7 +13695,6 @@ package Sinfo is
    pragma Inline (Set_Has_Created_Identifier);
    pragma Inline (Set_Has_Dereference_Action);
    pragma Inline (Set_Has_Dynamic_Length_Check);
-   pragma Inline (Set_Has_Dynamic_Range_Check);
    pragma Inline (Set_Has_Init_Expression);
    pragma Inline (Set_Has_Local_Raise);
    pragma Inline (Set_Has_No_Elaboration_Code);
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index d472d44..ffd0231 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -1131,12 +1131,6 @@ package body Treepr is
                Print_Eol;
             end if;
 
-            if Has_Dynamic_Range_Check (N) then
-               Print_Str (Prefix_Str_Char);
-               Print_Str ("Has_Dynamic_Range_Check = True");
-               Print_Eol;
-            end if;
-
             if Is_Controlling_Actual (N) then
                Print_Str (Prefix_Str_Char);
                Print_Str ("Is_Controlling_Actual = True");