public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r11-1873] [Ada] Ada2020: AI12-0198 potentially unevaluated components of arrays
@ 2020-07-07 9:27 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-07-07 9:27 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:dab6432039b8a92acd2bf4490771c9f5b347c005
commit r11-1873-gdab6432039b8a92acd2bf4490771c9f5b347c005
Author: Javier Miranda <miranda@adacore.com>
Date: Sun May 10 07:27:02 2020 -0400
[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.
Diff:
---
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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-07-07 9:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-07 9:27 [gcc r11-1873] [Ada] Ada2020: AI12-0198 potentially unevaluated components of arrays Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).