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

7 files changed, 59 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cd4e3a0..0b1afbc 100644
--- a/gcc/ada/ChangeLog
+++ b/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
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 1a8cc77..5fcc27d 100644
--- a/gcc/ada/decl.c
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9818fb4..1b0fbbd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 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
 	exports and document how these can be exercised.
 
diff --git a/gcc/testsuite/gnat.dg/tamdt.adb b/gcc/testsuite/gnat.dg/tamdt.adb
new file mode 100644
index 0000000..81af6ad
--- /dev/null
+++ b/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;
diff --git a/gcc/testsuite/gnat.dg/tamdt.ads b/gcc/testsuite/gnat.dg/tamdt.ads
new file mode 100644
index 0000000..09d9388
--- /dev/null
+++ b/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;
diff --git a/gcc/testsuite/gnat.dg/tamdt_aux.ads b/gcc/testsuite/gnat.dg/tamdt_aux.ads
new file mode 100644
index 0000000..d5cca10
--- /dev/null
+++ b/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;
+
+
+
diff --git a/gcc/testsuite/gnat.dg/test_tamdt.adb b/gcc/testsuite/gnat.dg/test_tamdt.adb
new file mode 100644
index 0000000..d0658ec
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_tamdt.adb
@@ -0,0 +1,8 @@
+-- { dg-do run }
+
+with Tamdt;
+
+procedure Test_Tamdt is
+begin
+   Tamdt.Check;
+end;