From fecdce4f35706aa82888a26c634c14b52b48b243 Mon Sep 17 00:00:00 2001 From: hainque Date: Fri, 7 Dec 2007 15:52:43 +0000 Subject: [PATCH] 2007-12-07 Olivier Hainque ada/ * decl.c (gnat_to_gnu_entity) : 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/decl.c | 3 ++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/tamdt.adb | 19 +++++++++++++++++++ gcc/testsuite/gnat.dg/tamdt.ads | 10 ++++++++++ gcc/testsuite/gnat.dg/tamdt_aux.ads | 9 +++++++++ gcc/testsuite/gnat.dg/test_tamdt.adb | 8 ++++++++ 7 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/tamdt.adb create mode 100644 gcc/testsuite/gnat.dg/tamdt.ads create mode 100644 gcc/testsuite/gnat.dg/tamdt_aux.ads create mode 100644 gcc/testsuite/gnat.dg/test_tamdt.adb 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 + + * decl.c (gnat_to_gnu_entity) : 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 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 + * gnat.dg/tamdt*.ad?: Support for ... + * gnat.dg/test_tamdt.adb: New test. + +2007-12-07 Olivier Hainque + * 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; -- 2.7.4