[Ada] Fix crash on taft amendment completion with private

Olivier Hainque hainque@adacore.com
Fri Dec 7 15:50:00 GMT 2007


Olivier Hainque wrote:
>  Bootstrapped and reg tested on x86_64-pc-linux-gnu.
> 
>  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.

 Humph, forgot the attachment.


-------------- next part --------------
Index: ada/ChangeLog
===================================================================
*** ada/ChangeLog	(revision 130673)
--- ada/ChangeLog	(working copy)
***************
*** 1,5 ****
--- 1,11 ----
  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  Olivier Hainque  <hainque@adacore.com>
+ 
  	PR ada/34173
  	* decl.c (gnat_to_gnu_entity) <case E_Array_Type>: When setting
  	the alignment on the GCC XUA array type, set TYPE_USER_ALIGN if
Index: ada/decl.c
===================================================================
*** ada/decl.c	(revision 130673)
--- ada/decl.c	(working copy)
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2996,3002 ****
  	     : (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)
  	      && IN (Ekind (gnat_desig_full_direct_first), Private_Kind))
  	     ? Full_View (gnat_desig_full_direct_first)
  	     : gnat_desig_full_direct_first);
--- 2996,3003 ----
  	     : (IN (Ekind (gnat_desig_equiv), Incomplete_Or_Private_Kind)
  		? Full_View (gnat_desig_equiv) : Empty));
  	Entity_Id gnat_desig_full_direct
! 	  = ((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);
Index: testsuite/gnat.dg/tamdt_aux.ads
===================================================================
*** testsuite/gnat.dg/tamdt_aux.ads	(revision 0)
--- testsuite/gnat.dg/tamdt_aux.ads	(revision 0)
***************
*** 0 ****
--- 1,9 ----
+ 
+ package Tamdt_Aux is
+    type Priv (X : Integer) is private;
+ private
+    type Priv (X : Integer) is null record;
+ end;
+ 
+ 
+ 
Index: testsuite/gnat.dg/tamdt.adb
===================================================================
*** testsuite/gnat.dg/tamdt.adb	(revision 0)
--- testsuite/gnat.dg/tamdt.adb	(revision 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;
Index: testsuite/gnat.dg/tamdt.ads
===================================================================
*** testsuite/gnat.dg/tamdt.ads	(revision 0)
--- testsuite/gnat.dg/tamdt.ads	(revision 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;
Index: testsuite/gnat.dg/test_tamdt.adb
===================================================================
*** testsuite/gnat.dg/test_tamdt.adb	(revision 0)
--- testsuite/gnat.dg/test_tamdt.adb	(revision 0)
***************
*** 0 ****
--- 1,8 ----
+ -- { dg-do run }
+ 
+ with Tamdt;
+ 
+ procedure Test_Tamdt is
+ begin
+    Tamdt.Check;
+ end;
Index: testsuite/ChangeLog
===================================================================
*** testsuite/ChangeLog	(revision 130678)
--- testsuite/ChangeLog	(working copy)
***************
*** 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.
  


More information about the Gcc-patches mailing list