[Ada] Ada2020: AI12-0198 potentially unevaluated components of arrays

Message ID 20200707092736.GA41470@adacore.com
State New
Headers show
Series
  • [Ada] Ada2020: AI12-0198 potentially unevaluated components of arrays
Related show

Commit Message

Pierre-Marie de Rodat July 7, 2020, 9:27 a.m.
Minor reformatting: This patch reorders the routines of the internal
package Interval_Lists. No functional change.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_util.ads (Interval_Lists): Reordering routine.
	* sem_util.adb (Interval_Lists): Reordering routines to keep
	them alphabetically ordered.

Patch

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -28897,6 +28897,16 @@  package body Sem_Util is
       --  Check that list is sorted, lacks null intervals, and has gaps
       --  between intervals.
 
+      function Chosen_Interval (Choice : Node_Id) return Discrete_Interval;
+      --  Given an element of a Discrete_Choices list, a
+      --  Static_Discrete_Predicate list, or an Others_Discrete_Choices
+      --  list (but not an N_Others_Choice node) return the corresponding
+      --  interval. If an element that does not represent a single
+      --  contiguous interval due to a static predicate (or which
+      --  represents a single contiguous interval whose bounds depend on
+      --  a static predicate) is encountered, then that is an error on the
+      --  part of whoever built the list in question.
+
       function In_Interval
         (Value : Uint; Interval : Discrete_Interval) return Boolean;
       --  Does the given value lie within the given interval?
@@ -28948,6 +28958,8 @@  package body Sem_Util is
          Intervals : Discrete_Interval_List (1 .. Max_I);
          Num_I     : Nat := 0;
 
+      --  Start of processing for Aggregate_Intervals
+
       begin
          --  No action needed if there are no intervals
 
@@ -28984,18 +28996,10 @@  package body Sem_Util is
          end;
       end Aggregate_Intervals;
 
-      -----------------
-      -- In_Interval --
-      -----------------
-      function In_Interval
-        (Value : Uint; Interval : Discrete_Interval) return Boolean is
-      begin
-         return Value >= Interval.Low and then Value <= Interval.High;
-      end In_Interval;
-
       ------------------------
       --  Check_Consistency --
       ------------------------
+
       procedure Check_Consistency (Intervals : Discrete_Interval_List) is
       begin
          if Serious_Errors_Detected > 0 then
@@ -29016,19 +29020,79 @@  package body Sem_Util is
          end loop;
       end Check_Consistency;
 
-      function Chosen_Interval (Choice : Node_Id) return Discrete_Interval;
-      --  Given an element of a Discrete_Choices list, a
-      --  Static_Discrete_Predicate list, or an Others_Discrete_Choices
-      --  list (but not an N_Others_Choice node) return the corresponding
-      --  interval. If an element that does not represent a single
-      --  contiguous interval due to a static predicate (or which
-      --  represents a single contiguous interval whose bounds depend on
-      --  a static predicate) is encountered, then that is an error on the
-      --  part of whoever built the list in question.
+      ---------------------------
+      -- Choice_List_Intervals --
+      ---------------------------
+
+      function Choice_List_Intervals
+        (Discrete_Choices : List_Id) return Discrete_Interval_List
+      is
+         function Unmerged_Choice_Count return Nat;
+         --  The number of intervals before adjacent intervals are merged.
+
+         ---------------------------
+         -- Unmerged_Choice_Count --
+         ---------------------------
+
+         function Unmerged_Choice_Count return Nat is
+            Choice : Node_Id := First (Discrete_Choices);
+            Count  : Nat := 0;
+         begin
+            while Present (Choice) loop
+               --  Non-contiguous choices involving static predicates
+               --  have already been normalized away.
+
+               if Nkind (Choice) = N_Others_Choice then
+                  Count :=
+                    Count + List_Length (Others_Discrete_Choices (Choice));
+               else
+                  Count := Count + 1;  -- an ordinary expression or range
+               end if;
+
+               Next (Choice);
+            end loop;
+            return Count;
+         end Unmerged_Choice_Count;
+
+         --  Local variables
+
+         Choice : Node_Id := First (Discrete_Choices);
+         Result : Discrete_Interval_List (1 .. Unmerged_Choice_Count);
+         Count  : Nat := 0;
+
+      --  Start of processing for Choice_List_Intervals
+
+      begin
+         while Present (Choice) loop
+            if Nkind (Choice) = N_Others_Choice then
+               declare
+                  Others_Choice : Node_Id
+                    := First (Others_Discrete_Choices (Choice));
+               begin
+                  while Present (Others_Choice) loop
+                     Count := Count + 1;
+                     Result (Count) := Chosen_Interval (Others_Choice);
+                     Next (Others_Choice);
+                  end loop;
+               end;
+            else
+               Count := Count + 1;
+               Result (Count) := Chosen_Interval (Choice);
+            end if;
+
+            Next (Choice);
+         end loop;
+
+         pragma Assert (Count = Result'Last);
+         Normalize_Interval_List (Result, Count);
+         Check_Consistency (Result (1 .. Count));
+         return Result (1 .. Count);
+      end Choice_List_Intervals;
 
       ---------------------
       -- Chosen_Interval --
       ---------------------
+
       function Chosen_Interval (Choice : Node_Id) return Discrete_Interval is
       begin
          case Nkind (Choice) is
@@ -29061,93 +29125,105 @@  package body Sem_Util is
          end case;
       end Chosen_Interval;
 
-      --------------------
-      -- Type_Intervals --
-      --------------------
-      function Type_Intervals
-        (Typ : Entity_Id) return Discrete_Interval_List
+      -----------------
+      -- In_Interval --
+      -----------------
+
+      function In_Interval
+        (Value : Uint; Interval : Discrete_Interval) return Boolean is
+      begin
+         return Value >= Interval.Low and then Value <= Interval.High;
+      end In_Interval;
+
+      ---------------
+      -- Is_Subset --
+      ---------------
+
+      function Is_Subset
+        (Subset, Of_Set : Discrete_Interval_List) return Boolean
       is
+         --  Returns True iff for each interval of Subset we can find
+         --  a single interval of Of_Set which contains the Subset interval.
       begin
-         if Has_Static_Predicate (Typ) then
-            declare
-               --  No sorting or merging needed
-               SDP_List : constant List_Id := Static_Discrete_Predicate (Typ);
-               Range_Or_Expr : Node_Id := First (SDP_List);
-               Result :
-                 Discrete_Interval_List (1 .. List_Length (SDP_List));
-            begin
-               for Idx in Result'Range loop
-                  Result (Idx) := Chosen_Interval (Range_Or_Expr);
-                  Next (Range_Or_Expr);
+         if Of_Set'Length = 0 then
+            return Subset'Length = 0;
+         end if;
+
+         declare
+            Set_Index : Pos range Of_Set'Range := Of_Set'First;
+
+         begin
+            for Ss_Idx in Subset'Range loop
+               while not In_Interval
+                 (Value    => Subset (Ss_Idx).Low,
+                  Interval => Of_Set (Set_Index))
+               loop
+                  if Set_Index = Of_Set'Last then
+                     return False;
+                  end if;
+
+                  Set_Index := Set_Index + 1;
                end loop;
-               pragma Assert (not Present (Range_Or_Expr));
-               Check_Consistency (Result);
-               return Result;
-            end;
-         else
-            declare
-               Low  : constant Uint := Expr_Value (Type_Low_Bound (Typ));
-               High : constant Uint := Expr_Value (Type_High_Bound (Typ));
-            begin
-               if Low > High then
-                  declare
-                     Null_Array : Discrete_Interval_List (1 .. 0);
-                  begin
-                     return Null_Array;
-                  end;
-               else
-                  return (1 => (Low => Low, High => High));
+
+               if not In_Interval
+                 (Value    => Subset (Ss_Idx).High,
+                  Interval => Of_Set (Set_Index))
+               then
+                  return False;
                end if;
-            end;
-         end if;
-      end Type_Intervals;
+            end loop;
+         end;
+
+         return True;
+      end Is_Subset;
 
       -----------------------------
       -- Normalize_Interval_List --
       -----------------------------
+
       procedure Normalize_Interval_List
-        (List : in out Discrete_Interval_List; Last : out Nat) is
+        (List : in out Discrete_Interval_List; Last : out Nat)
+      is
+         Temp_0 : Discrete_Interval := (others => Uint_0);
+         --  Cope with Heap_Sort_G idiosyncrasies.
 
-         procedure Move_Interval (From, To : Natural);
-         --  Copy interval from one location to another
+         function Is_Null (Idx : Pos) return Boolean;
+         --  True iff List (Idx) defines a null range
 
          function Lt_Interval (Idx1, Idx2 : Natural) return Boolean;
          --  Compare two list elements
 
-         Temp_0 : Discrete_Interval := (others => Uint_0);
-         --  cope with Heap_Sort_G idiosyncrasies.
+         procedure Merge_Intervals (Null_Interval_Count : out Nat);
+         --  Merge contiguous ranges by replacing one with merged range and
+         --  the other with a null value. Return a count of the null intervals,
+         --  both preexisting and those introduced by merging.
+
+         procedure Move_Interval (From, To : Natural);
+         --  Copy interval from one location to another
 
          function Read_Interval (From : Natural) return Discrete_Interval;
          --  Normal array indexing unless From = 0
 
-         -------------------
-         -- Read_Interval --
-         -------------------
-         function Read_Interval (From : Natural) return Discrete_Interval is
-         begin
-            if From = 0 then
-               return Temp_0;
-            else
-               return List (Pos (From));
-            end if;
-         end Read_Interval;
+         ----------------------
+         -- Interval_Sorting --
+         ----------------------
 
-         -------------------
-         -- Move_Interval --
-         -------------------
-         procedure Move_Interval (From, To : Natural) is
-            Rhs : constant Discrete_Interval := Read_Interval (From);
+         package Interval_Sorting is
+           new Gnat.Heap_Sort_G (Move_Interval, Lt_Interval);
+
+         -------------
+         -- Is_Null --
+         -------------
+
+         function Is_Null (Idx : Pos) return Boolean is
          begin
-            if To = 0 then
-               Temp_0 := Rhs;
-            else
-               List (Pos (To)) := Rhs;
-            end if;
-         end Move_Interval;
+            return List (Idx).Low > List (Idx).High;
+         end Is_Null;
 
          -----------------
          -- Lt_Interval --
          -----------------
+
          function Lt_Interval (Idx1, Idx2 : Natural) return Boolean is
             Elem1  : constant Discrete_Interval := Read_Interval (Idx1);
             Elem2  : constant Discrete_Interval := Read_Interval (Idx2);
@@ -29157,33 +29233,19 @@  package body Sem_Util is
             if Null_1 /= Null_2 then
                --  So that sorting moves null intervals to high end
                return Null_2;
+
             elsif Elem1.Low /= Elem2.Low then
                return Elem1.Low < Elem2.Low;
+
             else
                return Elem1.High < Elem2.High;
             end if;
          end Lt_Interval;
 
-         package Interval_Sorting is
-           new Gnat.Heap_Sort_G (Move_Interval, Lt_Interval);
-
-         function Is_Null (Idx : Pos) return Boolean;
-         --  True iff List (Idx) defines a null range
-
-         function Is_Null (Idx : Pos) return Boolean is
-         begin
-            return List (Idx).Low > List (Idx).High;
-         end Is_Null;
-
-         procedure Merge_Intervals (Null_Interval_Count : out Nat);
-         --  Merge contiguous ranges by replacing one with merged range
-         --  and the other with a null value. Return a count of the
-         --  null intervals, both preexisting and those introduced by
-         --  merging.
-
          ---------------------
          -- Merge_Intervals --
          ---------------------
+
          procedure Merge_Intervals (Null_Interval_Count : out Nat) is
             Not_Null : Pos range List'Range;
             --  Index of the most recently examined non-null interval
@@ -29199,17 +29261,24 @@  package body Sem_Util is
 
             Null_Interval_Count := 0;
             Not_Null := List'First;
+
             for Idx in List'First + 1 .. List'Last loop
                if Is_Null (Idx) then
+
                   --  all remaining elements are null
+
                   Null_Interval_Count :=
                     Null_Interval_Count + List (Idx .. List'Last)'Length;
                   return;
+
                elsif List (Idx).Low = List (Not_Null).High + 1 then
+
                   --  Merge the two intervals into one; discard the other
+
                   List (Not_Null).High := List (Idx).High;
                   List (Idx) := Null_Interval;
                   Null_Interval_Count := Null_Interval_Count + 1;
+
                else
                   if List (Idx).Low <= List (Not_Null).High then
                      raise Intervals_Error;
@@ -29220,13 +29289,46 @@  package body Sem_Util is
                end if;
             end loop;
          end Merge_Intervals;
+
+         -------------------
+         -- Move_Interval --
+         -------------------
+
+         procedure Move_Interval (From, To : Natural) is
+            Rhs : constant Discrete_Interval := Read_Interval (From);
+         begin
+            if To = 0 then
+               Temp_0 := Rhs;
+            else
+               List (Pos (To)) := Rhs;
+            end if;
+         end Move_Interval;
+
+         -------------------
+         -- Read_Interval --
+         -------------------
+
+         function Read_Interval (From : Natural) return Discrete_Interval is
+         begin
+            if From = 0 then
+               return Temp_0;
+            else
+               return List (Pos (From));
+            end if;
+         end Read_Interval;
+
+      --  Start of processing for Normalize_Interval_Lists
+
       begin
          Interval_Sorting.Sort (Natural (List'Last));
+
          declare
             Null_Interval_Count : Nat;
+
          begin
             Merge_Intervals (Null_Interval_Count);
             Last := List'Last - Null_Interval_Count;
+
             if Null_Interval_Count /= 0 then
                --  Move null intervals introduced during merging to high end
                Interval_Sorting.Sort (Natural (List'Last));
@@ -29234,104 +29336,47 @@  package body Sem_Util is
          end;
       end Normalize_Interval_List;
 
-      ---------------------------
-      -- Choice_List_Intervals --
-      ---------------------------
-      function Choice_List_Intervals
-        (Discrete_Choices : List_Id) return Discrete_Interval_List
-      is
-         function Unmerged_Choice_Count return Nat;
-         --  The number of intervals before adjacent intervals are merged.
-
-         ---------------------------
-         -- Unmerged_Choice_Count --
-         ---------------------------
-         function Unmerged_Choice_Count return Nat is
-            Choice : Node_Id := First (Discrete_Choices);
-            Count  : Nat := 0;
-         begin
-            while Present (Choice) loop
-               --  Non-contiguous choices involving static predicates
-               --  have already been normalized away.
-
-               if Nkind (Choice) = N_Others_Choice then
-                  Count :=
-                    Count + List_Length (Others_Discrete_Choices (Choice));
-               else
-                  Count := Count + 1;  -- an ordinary expression or range
-               end if;
-
-               Next (Choice);
-            end loop;
-            return Count;
-         end Unmerged_Choice_Count;
-
-         Choice : Node_Id := First (Discrete_Choices);
-         Result : Discrete_Interval_List (1 .. Unmerged_Choice_Count);
-         Count  : Nat := 0;
-      begin
-         while Present (Choice) loop
-            if Nkind (Choice) = N_Others_Choice then
-               declare
-                  Others_Choice : Node_Id
-                    := First (Others_Discrete_Choices (Choice));
-               begin
-                  while Present (Others_Choice) loop
-                     Count := Count + 1;
-                     Result (Count) := Chosen_Interval (Others_Choice);
-                     Next (Others_Choice);
-                  end loop;
-               end;
-            else
-               Count := Count + 1;
-               Result (Count) := Chosen_Interval (Choice);
-            end if;
-            Next (Choice);
-         end loop;
-         pragma Assert (Count = Result'Last);
-         Normalize_Interval_List (Result, Count);
-         Check_Consistency (Result (1 .. Count));
-         return Result (1 .. Count);
-      end Choice_List_Intervals;
+      --------------------
+      -- Type_Intervals --
+      --------------------
 
-      ---------------
-      -- Is_Subset --
-      ---------------
-      function Is_Subset
-        (Subset, Of_Set : Discrete_Interval_List) return Boolean
+      function Type_Intervals (Typ : Entity_Id) return Discrete_Interval_List
       is
-         --  Returns True iff for each interval of Subset we can find
-         --  a single interval of Of_Set which contains the Subset interval.
       begin
-         if Of_Set'Length = 0 then
-            return Subset'Length = 0;
-         end if;
+         if Has_Static_Predicate (Typ) then
+            declare
+               --  No sorting or merging needed
+               SDP_List : constant List_Id := Static_Discrete_Predicate (Typ);
+               Range_Or_Expr : Node_Id := First (SDP_List);
+               Result : Discrete_Interval_List (1 .. List_Length (SDP_List));
 
-         declare
-            Set_Index : Pos range Of_Set'Range := Of_Set'First;
-         begin
-            for Ss_Idx in Subset'Range loop
-               while not In_Interval
-                 (Value    => Subset (Ss_Idx).Low,
-                  Interval => Of_Set (Set_Index))
-               loop
-                  if Set_Index = Of_Set'Last then
-                     return False;
-                  end if;
-                  Set_Index := Set_Index + 1;
+            begin
+               for Idx in Result'Range loop
+                  Result (Idx) := Chosen_Interval (Range_Or_Expr);
+                  Next (Range_Or_Expr);
                end loop;
 
-               if not In_Interval
-                 (Value    => Subset (Ss_Idx).High,
-                  Interval => Of_Set (Set_Index))
-               then
-                  return False;
+               pragma Assert (not Present (Range_Or_Expr));
+               Check_Consistency (Result);
+               return Result;
+            end;
+         else
+            declare
+               Low  : constant Uint := Expr_Value (Type_Low_Bound (Typ));
+               High : constant Uint := Expr_Value (Type_High_Bound (Typ));
+            begin
+               if Low > High then
+                  declare
+                     Null_Array : Discrete_Interval_List (1 .. 0);
+                  begin
+                     return Null_Array;
+                  end;
+               else
+                  return (1 => (Low => Low, High => High));
                end if;
-            end loop;
-         end;
-
-         return True;
-      end Is_Subset;
+            end;
+         end if;
+      end Type_Intervals;
 
    end Interval_Lists;
 


diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -3122,17 +3122,17 @@  package Sem_Util is
       --  components are covered by the others choice then the length of the
       --  result is zero.
 
+      function Choice_List_Intervals
+        (Discrete_Choices : List_Id) return Discrete_Interval_List;
+      --  Given a discrete choice list, returns the (unique) interval
+      --  list representing the chosen values.
+
       function Type_Intervals (Typ : Entity_Id) return Discrete_Interval_List;
       --  Given a static discrete type or subtype, returns the (unique)
       --  interval list representing the values of the type/subtype.
       --  If no static predicates are involved, the length of the result
       --  will be at most one.
 
-      function Choice_List_Intervals (Discrete_Choices : List_Id)
-                                     return Discrete_Interval_List;
-      --  Given a discrete choice list, returns the (unique) interval
-      --  list representing the chosen values.
-
       function Is_Subset (Subset, Of_Set : Discrete_Interval_List)
         return Boolean;
       --  Returns True iff every value belonging to some interval of