From dab6432039b8a92acd2bf4490771c9f5b347c005 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Sun, 10 May 2020 07:27:02 -0400 Subject: [PATCH] [Ada] Ada2020: AI12-0198 potentially unevaluated components of arrays gcc/ada/ * sem_util.ads (Interval_Lists): Reordering routine. * sem_util.adb (Interval_Lists): Reordering routines to keep them alphabetically ordered. --- gcc/ada/sem_util.adb | 423 ++++++++++++++++++++++++------------------- gcc/ada/sem_util.ads | 10 +- 2 files changed, 239 insertions(+), 194 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 36efebb8aa7..9383c5f6d0d 100644 --- 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 index 22be399488e..fc8177c8385 100644 --- 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 -- 2.30.2