This patch corrects the decoration of type attribute Has_Unknown_Discriminants when building the full view of a private subtype.
------------ -- Source -- ------------ -- root.ads package Root is end Root; -- root-scopes.ads package Root.Scopes is type Scope_T is interface; function Scope_Of (Scope_Name : String) return Scope_T is abstract; end Root.Scopes; -- root-scopes-basics.ads private package Root.Scopes.Basics is type Scope_T (Length : Natural) is abstract new Root.Scopes.Scope_T with record Name : String (1 .. Length) := (others => ' '); end record; end Root.Scopes.Basics; -- root-scopes-domains.ads private with Root.Scopes.Basics; generic package Root.Scopes.Domains is type Scope_T (<>) is new Root.Scopes.Scope_T with private; overriding function Scope_Of (Scope_Name : String) return Scope_T; private subtype Parent_T is Root.Scopes.Basics.Scope_T; type Scope_T is new Parent_T with record Comp : Integer; end record; end Root.Scopes.Domains; -- root-scopes-domains.adb package body Root.Scopes.Domains is function Scope_Of (Scope_Name : String) return Scope_T is begin return (Length => Scope_Name'Length, Name => Scope_Name, Comp => 5); end Scope_Of; end Root.Scopes.Domains; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with Root.Scopes.Domains; procedure Main is package Inst is new Root.Scopes.Domains; subtype Scope_T is Inst.Scope_T; S_1 : constant Scope_T := Inst.Scope_Of ("One"); S_2 : Scope_T renames S_1; S_3 : Scope_T := Inst.Scope_Of ("Three"); begin Put_Line ("OK"); end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q -gnat05 main.adb $ ./main OK Tested on x86_64-pc-linux-gnu, committed on trunk 2013-02-06 Hristian Kirtchev <kirtc...@adacore.com> * sem_ch3.adb (Complete_Private_Subtype): Inherit the Has_Unknown_Discriminants from the full view of the base type.
Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 195788) +++ sem_ch3.adb (working copy) @@ -10255,15 +10255,17 @@ Protected_Kind => Copy_Node (Priv, Full); - Set_Has_Discriminants (Full, Has_Discriminants (Full_Base)); - Set_First_Entity (Full, First_Entity (Full_Base)); - Set_Last_Entity (Full, Last_Entity (Full_Base)); + Set_Has_Discriminants (Full, Has_Discriminants (Full_Base)); + Set_Has_Unknown_Discriminants + (Full, Has_Unknown_Discriminants (Full_Base)); + Set_First_Entity (Full, First_Entity (Full_Base)); + Set_Last_Entity (Full, Last_Entity (Full_Base)); when others => Copy_Node (Full_Base, Full); - Set_Chars (Full, Chars (Priv)); - Conditional_Delay (Full, Priv); - Set_Sloc (Full, Sloc (Priv)); + Set_Chars (Full, Chars (Priv)); + Conditional_Delay (Full, Priv); + Set_Sloc (Full, Sloc (Priv)); end case; Set_Next_Entity (Full, Save_Next_Entity); @@ -17388,7 +17390,6 @@ if Is_Private_Type (Id_B) then Append_Elmt (Id, Private_Dependents (Id_B)); end if; - end Prepare_Private_Subtype_Completion; ---------------------------