[Ada] Full views of private subtypes with unknown discriminants.

[Arnaud Charlet]

A private subtype with unknown discriminants may have a full view that is
a constrained discriminated subtype. The Is_Constrained flag must be properly
set for this full view, to prevent spurious errors when the subtype is used
in an object declaration with a dynamically tagged expression.

The execution of:

     gnatmake -q -gna05 extra_class_main.adb
     extra_class_main

must yield:

    FALSE
     123

-- 
with Extra_Class.Inner;
procedure Extra_Class_Main is
   package Extra is new Extra_Class.IO (Extra_Class.Inner.Ex_ATP);

begin
   Extra.Dummy;
end Extra_Class_Main;
--
package Extra_Class is
   type ATP (<>) is abstract tagged private;
   function Initialize return ATP is abstract;

   generic
      type UATP (<>) is new ATP with private;
   package IO is

      procedure Dummy;
   end IO;

private
   type ATP (Size : Natural) is abstract tagged record
      Active : Boolean := False;
   end record;
end Extra_Class;
--
package body Extra_Class.Inner is
   function Initialize return Ex_ATP is
      Value : Ex_ATP;
   begin
      return Value;
   end Initialize;
end Extra_Class.Inner;
---
with Text_IO; use Text_IO;
package body Extra_Class is

   package body IO is

      UATP_O : UATP'Class := UATP'(Initialize);   --  Workaround
      UATP_1 : UATP := UATP'(Initialize);

      procedure Dummy is
      begin
        null;
        UATP_1.Active := UATP_1.Size = 1;
        Put_Line (Boolean'image (UATP_1.Active));
        Put_Line (Integer'image (UATP_1.Size));
      end Dummy;

   end IO;

end Extra_Class;
---
package Extra_Class.Inner is
   type Ex_ATP is new Extra_Class.ATP with private;
   function Initialize return Ex_ATP;

private
   type Ex_ATP is new Extra_Class.ATP (123) with null record;
end Extra_Class.Inner;

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-10-14  Ed Schonberg  <schonb...@adacore.com>

        * sem_ch3.adb (Complete_Private_Subtype): If the full view of
        the base type is constrained, the full view of the subtype is
        known to be constrained as well.


Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 203522)
+++ sem_ch3.adb (working copy)
@@ -10393,6 +10393,14 @@
             Set_First_Entity (Full, First_Entity (Full_Base));
             Set_Last_Entity  (Full, Last_Entity (Full_Base));
 
+            --  If the underlying base type is constrained, we know that the
+            --  full view of the subtype is constrained as well (the converse
+            --  is not necessarily true).
+
+            if Is_Constrained (Full_Base) then
+               Set_Is_Constrained (Full);
+            end if;
+
          when others =>
             Copy_Node (Full_Base, Full);