The compiler reports a spurious error notifying a missing constraint in the
declaration of a private type with discriminants whose full view is a
derivation of a task type.
After this patch the following test compiles without errors.
package Types1 is
type Parent (Discr1 : Boolean) is limited private;
private
task type Parent (Discr1 : Boolean);
end Types1;
with Types1; use Types1;
package Types2 is
type Child (Discr2 : Boolean) is limited private;
private
type Child (Discr2 : Boolean) is -- Test
new Parent (Discr1 => Discr2);
end Types2;
Command: gcc -c types2.ads
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-24 Javier Miranda <mira...@adacore.com>
gcc/ada/
* sem_util.adb (Abstract_Interface_List): Add missing support for
private types whose full view is a synchronized type.
* sem_ch3.adb (Build_Derived_Private_Type): Skip building the full
derivation of a private type parent type is a task type with
discriminants as gigi does not use such type directly.--- gcc/ada/sem_ch3.adb
+++ gcc/ada/sem_ch3.adb
@@ -7856,12 +7856,12 @@ package body Sem_Ch3 is
-- Build the full derivation if this is not the anonymous derived
-- base type created by Build_Derived_Record_Type in the constrained
-- case (see point 5. of its head comment) since we build it for the
- -- derived subtype. And skip it for protected types altogether, as
+ -- derived subtype. And skip it for synchronized types altogether, as
-- gigi does not use these types directly.
if Present (Full_View (Parent_Type))
and then not Is_Itype (Derived_Type)
- and then not (Ekind (Full_View (Parent_Type)) in Protected_Kind)
+ and then not (Is_Concurrent_Type (Full_View (Parent_Type)))
then
declare
Der_Base : constant Entity_Id := Base_Type (Derived_Type);
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -184,11 +184,11 @@ package body Sem_Util is
-- If we are dealing with a synchronized subtype, go to the base
-- type, whose declaration has the interface list.
- -- Shouldn't this be Declaration_Node???
+ Nod := Declaration_Node (Base_Type (Typ));
- Nod := Parent (Base_Type (Typ));
-
- if Nkind (Nod) = N_Full_Type_Declaration then
+ if Nkind_In (Nod, N_Full_Type_Declaration,
+ N_Private_Type_Declaration)
+ then
return Empty_List;
end if;
