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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130679 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cd4e3a0..0b1afbc 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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;