From: Gary Dismukes Date: Mon, 15 Oct 2007 13:56:36 +0000 (+0200) Subject: sem_ch3.adb (Build_Derived_Concurrent_Type): Set the Is_Constrained flag of derived... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=0501956d00279d9194fc417293f8601861fcd29a;p=gcc.git sem_ch3.adb (Build_Derived_Concurrent_Type): Set the Is_Constrained flag of derived concurrent types... 2007-10-15 Gary Dismukes * sem_ch3.adb (Build_Derived_Concurrent_Type): Set the Is_Constrained flag of derived concurrent types, taking into account the flag setting on the parent subtype and any new set of discriminants. From-SVN: r129333 --- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e6d0781df4c..6bddb202db9 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3855,6 +3855,12 @@ package body Sem_Ch3 is Dont_Care : Boolean; Others_Present : Boolean := False; + pragma Warnings (Off, Case_Table); + pragma Warnings (Off, Last_Choice); + pragma Warnings (Off, Dont_Care); + pragma Warnings (Off, Others_Present); + -- We don't care about the assigned values of any of these + -- Start of processing for Analyze_Variant_Part begin @@ -4573,6 +4579,14 @@ package body Sem_Ch3 is Set_Corresponding_Record_Type (Derived_Type, Corresponding_Record_Type (Parent_Type)); + -- Is_Constrained is set according the parent subtype, but is set to + -- False if the derived type is declared with new discriminants. + + Set_Is_Constrained + (Derived_Type, + (Is_Constrained (Parent_Type) or else Constraint_Present) + and then not Present (Discriminant_Specifications (N))); + if Constraint_Present then if not Has_Discriminants (Parent_Type) then Error_Msg_N ("untagged parent must have discriminants", N);