decl.c (gnat_to_gnu_entity): When computing the designated full view...

2007-12-07  Olivier Hainque  <hainque@adacore.com>

	ada/
	* 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.

	testsuite/
	* gnat.dg/tamdt*.ad?: Support for ...
	* gnat.dg/test_tamdt.adb: New test.

From-SVN: r130679

gcc/ada/ChangeLog

@@ -1,3 +1,9 @@
+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

gcc/ada/decl.c

@@ -2996,7 +2996,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	     : (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);

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+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

gcc/testsuite/gnat.dg/tamdt.adb

@@ -0,0 +1,19 @@
+
+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;

gcc/testsuite/gnat.dg/tamdt.ads

@@ -0,0 +1,10 @@
+
+package TAMDT is
+   procedure Check;
+private
+   type TAMT1;
+   type TAMT1_Access is access TAMT1;
+
+   type TAMT2;
+   type TAMT2_Access is access TAMT2;
+end;

gcc/testsuite/gnat.dg/tamdt_aux.ads

@@ -0,0 +1,9 @@
+
+package Tamdt_Aux is
+   type Priv (X : Integer) is private;
+private
+   type Priv (X : Integer) is null record;
+end;
+
+
+

gcc/testsuite/gnat.dg/test_tamdt.adb

@@ -0,0 +1,8 @@
+-- { dg-do run }
+
+with Tamdt;
+
+procedure Test_Tamdt is
+begin
+   Tamdt.Check;
+end;