From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Steve Baird <baird@adacore.com>
Subject: [Ada] ICE handling discriminant-dependent index constraint for access component
Date: Tue, 6 Sep 2022 09:15:43 +0200 [thread overview]
Message-ID: <20220906071543.GA1280232@poulhies-Precision-5550> (raw)
[-- Attachment #1: Type: text/plain, Size: 1073 bytes --]
The compiler would fail with an internal error in some cases involving
a discriminated record type that provides a discriminant-dependent index
constraint for the subtype of a component of an access-to-array type when a
dereference of that component of some object is mentioned in a pre- or
postcondition expression.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_ch4.adb
(Analyze_Selected_Component): Define new Boolean-valued function,
Constraint_Has_Unprefixed_Discriminant_Reference, which takes a
subtype that is subject to a discriminant-dependent constraint and
returns True if any of the constraint values are unprefixed
discriminant names. Usually, the Etype of a selected component
node is set to Etype of the component. However, in the case of an
access-to-array component for which this predicate returns True,
we instead use the base type of the Etype of the component.
Normally such problematic discriminant references are addressed by
calling Build_Actual_Subtype_Of_Component, but that doesn't work
if Full_Analyze is False.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5000 bytes --]
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4814,6 +4814,14 @@ package body Sem_Ch4 is
Is_Single_Concurrent_Object : Boolean;
-- Set True if the prefix is a single task or a single protected object
+ function Constraint_Has_Unprefixed_Discriminant_Reference
+ (Typ : Entity_Id) return Boolean;
+ -- Given a subtype that is subject to a discriminant-dependent
+ -- constraint, returns True if any of the values of the constraint
+ -- (i.e., any of the index values for an index constraint, any of
+ -- the discriminant values for a discriminant constraint)
+ -- are unprefixed discriminant names.
+
procedure Find_Component_In_Instance (Rec : Entity_Id);
-- In an instance, a component of a private extension may not be visible
-- while it was visible in the generic. Search candidate scope for a
@@ -4842,6 +4850,56 @@ package body Sem_Ch4 is
-- _Procedure, and collect all its interpretations (since it may be an
-- overloaded interface primitive); otherwise return False.
+ ------------------------------------------------------
+ -- Constraint_Has_Unprefixed_Discriminant_Reference --
+ ------------------------------------------------------
+
+ function Constraint_Has_Unprefixed_Discriminant_Reference
+ (Typ : Entity_Id) return Boolean
+ is
+
+ function Is_Discriminant_Name (N : Node_Id) return Boolean is
+ ((Nkind (N) = N_Identifier)
+ and then (Ekind (Entity (N)) = E_Discriminant));
+ begin
+ if Is_Array_Type (Typ) then
+ declare
+ Index : Node_Id := First_Index (Typ);
+ Rng : Node_Id;
+ begin
+ while Present (Index) loop
+ Rng := Index;
+ if Nkind (Rng) = N_Subtype_Indication then
+ Rng := Range_Expression (Constraint (Rng));
+ end if;
+
+ if Nkind (Rng) = N_Range then
+ if Is_Discriminant_Name (Low_Bound (Rng))
+ or else Is_Discriminant_Name (High_Bound (Rng))
+ then
+ return True;
+ end if;
+ end if;
+
+ Next_Index (Index);
+ end loop;
+ end;
+ else
+ declare
+ Elmt : Elmt_Id := First_Elmt (Discriminant_Constraint (Typ));
+ begin
+ while Present (Elmt) loop
+ if Is_Discriminant_Name (Node (Elmt)) then
+ return True;
+ end if;
+ Next_Elmt (Elmt);
+ end loop;
+ end;
+ end if;
+
+ return False;
+ end Constraint_Has_Unprefixed_Discriminant_Reference;
+
--------------------------------
-- Find_Component_In_Instance --
--------------------------------
@@ -5289,6 +5347,33 @@ package body Sem_Ch4 is
end;
end if;
+ -- If Etype (Comp) is an access type whose designated subtype
+ -- is constrained by an unprefixed discriminant value,
+ -- then ideally we would build a new subtype with an
+ -- appropriately prefixed discriminant value and use that
+ -- instead, as is done in Build_Actual_Subtype_Of_Component.
+ -- That turns out to be difficult in this context (with
+ -- Full_Analysis = False, we could be processing a selected
+ -- component that occurs in a Postcondition pragma;
+ -- PPC pragmas are odd because they can contain references
+ -- to formal parameters that occur outside the subprogram).
+ -- So instead we punt on building a new subtype and we
+ -- use the base type instead. This might introduce
+ -- correctness problems if N were the target of an
+ -- assignment (because a required check might be omitted);
+ -- fortunately, that's impossible because a reference to the
+ -- current instance of a type does not denote a variable view
+ -- when the reference occurs within an aspect_specification.
+ -- GNAT's Precondition and Postcondition pragmas follow the
+ -- same rules as a Pre or Post aspect_specification.
+
+ elsif Has_Discriminant_Dependent_Constraint (Comp)
+ and then Ekind (Etype (Comp)) = E_Access_Subtype
+ and then Constraint_Has_Unprefixed_Discriminant_Reference
+ (Designated_Type (Etype (Comp)))
+ then
+ Set_Etype (N, Base_Type (Etype (Comp)));
+
-- If Full_Analysis not enabled, just set the Etype
else
reply other threads:[~2022-09-06 7:15 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220906071543.GA1280232@poulhies-Precision-5550 \
--to=poulhies@adacore.com \
--cc=baird@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).