From 0501956d00279d9194fc417293f8601861fcd29a Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 15 Oct 2007 15:56:36 +0200 Subject: [PATCH] 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 --- gcc/ada/sem_ch3.adb | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e6d0781df4c5..6bddb202db96 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);