sem_ch3.adb (Build_Derived_Concurrent_Type): Set the Is_Constrained flag of derived...
authorGary Dismukes <dismukes@adacore.com>
Mon, 15 Oct 2007 13:56:36 +0000 (15:56 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 15 Oct 2007 13:56:36 +0000 (15:56 +0200)
2007-10-15  Gary Dismukes  <dismukes@adacore.com>

* 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

index e6d0781df4c5593e651915dfd298d95579416530..6bddb202db960f4cef67ac15f2fde5635891284e 100644 (file)
@@ -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);