When compiling with -gnatc (or any mode that turns off the expansion phase),
the compiler gets an Assertion_Failure when attempting to retrieve the body
discriminal of a discriminant of a protected type. In the absence of expansion,
a concurrent record type is not created, so this possibility has to be
accounted for when retrieving body discriminals.
The following test must compile quietly with -gnatc:
procedure Requeue_Bug is
type Boolean_Array is array (Positive range <>) of Boolean;
protected type Protected_Type (Length : Positive) is
entry Wait (Positive range 1 .. Length) (New_State : in Boolean);
entry Wait_Next (New_State : in Boolean);
private
Available : Boolean_Array (1 .. Length) := (others => False);
end Protected_Type;
protected body Protected_Type is
entry Wait
(for J in Positive range 1 .. Length) (New_State : in Boolean)
when Available (J)
is
begin
null;
end Wait;
entry Wait_Next (New_State : in Boolean) when True is
begin
for J in 1 .. Length loop
if not Available (J) then
requeue Wait (J);
end if;
end loop;
end Wait_Next;
end Protected_Type;
begin
null;
end Requeue_Bug;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-31 Gary Dismukes <dismu...@adacore.com>
* sem_util.adb (Find_Body_Discriminal): Test whether the scope of the
spec discriminant is already a concurrent type, in which case just use
it, otherwise fetch the Corresponding_Concurrent_Type as before.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 178355)
+++ sem_util.adb (working copy)
@@ -3701,13 +3701,22 @@
function Find_Body_Discriminal
(Spec_Discriminant : Entity_Id) return Entity_Id
is
- pragma Assert (Is_Concurrent_Record_Type (Scope (Spec_Discriminant)));
-
- Tsk : constant Entity_Id :=
- Corresponding_Concurrent_Type (Scope (Spec_Discriminant));
+ Tsk : Entity_Id;
Disc : Entity_Id;
begin
+ -- If expansion is suppressed, then the scope can be the concurrent type
+ -- itself rather than a corresponding concurrent record type.
+
+ if Is_Concurrent_Type (Scope (Spec_Discriminant)) then
+ Tsk := Scope (Spec_Discriminant);
+
+ else
+ pragma Assert (Is_Concurrent_Record_Type (Scope (Spec_Discriminant)));
+
+ Tsk := Corresponding_Concurrent_Type (Scope (Spec_Discriminant));
+ end if;
+
-- Find discriminant of original concurrent type, and use its current
-- discriminal, which is the renaming within the task/protected body.
