===================================================================
@@ -17660,8 +17660,13 @@
end if;
while Present (Disc) loop
- pragma Assert (Present (Assoc));
+ -- If no further associations return the discriminant, value
+ -- will be found on the second pass.
+ if No (Assoc) then
+ return Result;
+ end if;
+
if Original_Record_Component (Disc) = Result_Entity then
return Node (Assoc);
end if;
@@ -17690,6 +17695,8 @@
-- ??? This routine is a gigantic mess and will be deleted. For the
-- time being just test for the trivial case before calling recurse.
+ -- We are now celebrating the 20th anniversary of this comment!
+
if Base_Type (Scope (Discriminant)) = Base_Type (Typ_For_Constraint) then
declare
D : Entity_Id;
This patch fixes a compiler abort on an object declaration for a private type with discriminants, when the full view of the type is derived from an ancestor with additional discriminants and the derivation chain includes discriminant renamings. Executing gnatmake -q main main must yield: 13 --- with Types; use Types; with Text_IO; use Text_IO; procedure Main is Obj : Deriv_13 (13); begin Put_Line (Integer'Image (Obj.D_1)); end Main; --- package Types is type Par_13 (D_1 : Integer; D_2 : Integer) is tagged private; type Mid_13 (D_3 : Integer) is new Par_13 with private; type Deriv_13 (D_1 : Integer) is tagged private; private type Par_13 (D_1 : Integer; D_2 : Integer) is tagged null record; type Mid_13 (D_3 : Integer) is new Par_13 (D_1 => 123, D_2 => D_3) with null record; type Deriv_13 (D_1 : Integer) is new Mid_13 (D_3 => D_1) with null record; end Types; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Get_Discriminant_Value, Search_Derivation_Levels): Handle properly a multi- level derivation involving both renamed and constrained parent discriminants, when the type to be constrained has fewer discriminants that the ultimate ancestor.