+2007-12-07 Olivier Hainque <hainque@adacore.com>
+
+ * decl.c (gnat_to_gnu_entity) <case E_Access_Type>: When computing
+ the designated full view, only follow a second level Full_View link
+ for Non_Limited_Views of from_limited_with references.
+
2007-12-07 Samuel Tardieu <sam@rfc1149.net>
PR ada/15805
: (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind)
? Full_View (gnat_desig_equiv) : Empty));
Entity_Id gnat_desig_full_direct
- = ((Present (gnat_desig_full_direct_first)
+ = ((is_from_limited_with
+ && Present (gnat_desig_full_direct_first)
&& IN (Ekind (gnat_desig_full_direct_first), Private_Kind))
? Full_View (gnat_desig_full_direct_first)
: gnat_desig_full_direct_first);
+2007-12-07 Olivier Hainque <hainque@adacore.com>
+
+ * gnat.dg/tamdt*.ad?: Support for ...
+ * gnat.dg/test_tamdt.adb: New test.
+
2007-12-07 Olivier Hainque <hainque@adacore.com>
* gnat.dg/unc_memops.ads: Comment out the alloc/free/realloc
--- /dev/null
+
+with Tamdt_Aux;
+
+package body TAMDT is
+ type TAMT1 is new Tamdt_Aux.Priv (X => 1);
+ type TAMT2 is new Tamdt_Aux.Priv;
+
+ procedure Check is
+ Ptr1 : TAMT1_Access := new TAMT1;
+ Ptr2 : TAMT2_Access := new TAMT2 (X => 2);
+ begin
+ if Ptr1.all.X /= 1 then
+ raise Program_Error;
+ end if;
+ if Ptr2.all.X /= 2 then
+ raise Program_Error;
+ end if;
+ end;
+end;
--- /dev/null
+
+package TAMDT is
+ procedure Check;
+private
+ type TAMT1;
+ type TAMT1_Access is access TAMT1;
+
+ type TAMT2;
+ type TAMT2_Access is access TAMT2;
+end;
--- /dev/null
+
+package Tamdt_Aux is
+ type Priv (X : Integer) is private;
+private
+ type Priv (X : Integer) is null record;
+end;
+
+
+
--- /dev/null
+-- { dg-do run }
+
+with Tamdt;
+
+procedure Test_Tamdt is
+begin
+ Tamdt.Check;
+end;