2005-12-05 Robert Dewar <dewar@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Itype_Printed): New flag
	(Is_Limited_Type): Derived types do not inherit limitedness from
	interface progenitors.
	(Is_Return_By_Reference_Type): Predicate does not apply to limited
	interfaces.

	* einfo.ads (Itype_Printed): New flag
	Move Is_Wrapper_Package to proper section
	Add missing Inline for Is_Volatile

	* output.ads, output.adb (Write_Erase_Char): New procedure
	(Save/Restore_Output_Buffer): New procedures
	(Save/Restore_Output_Buffer): New procedures

	* sprint.ads, sprint.adb (Write_Itype): Handle case of record itypes
	Add missing support for anonymous access type
	(Write_Id): Insert calls to Write_Itype
	(Write_Itype): New procedure to output itypes

	* par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada 2005, handle
	use of "limited" in declaration.

	* sinfo.ads, sinfo.adb: 
	Formal derived types can carry an explicit "limited" indication.

	* sem_ch3.adb: Add with and use of Targparm.
	(Create_Component): If Frontend_Layout_On_Target is True and the
	copied component does not have a known static Esize, then reset
	the size and positional fields of the new component.
	(Analyze_Component_Declaration): A limited component is
	legal within a protected type that implements an interface.
	(Collect_Interfaces): Do not add to the list the interfaces that
	are implemented by the ancestors.
	(Derived_Type_Declaration): If the parent of the full-view is an
	interface perform a transformation of the tree to ensure that it has
	the same parent than the partial-view. This simplifies the job of the
	expander in order to generate the correct object layout, and it is
	needed because the list of interfaces of the full-view can be given in
	any order.
	(Process_Full_View): The parent of the full-view does not need to be
	a descendant of the parent of the partial view if both parents are
	interfaces.
	(Analyze_Private_Extension_Declaration): If declaration has an explicit
	"limited" the parent must be a limited type.
	(Build_Derived_Record_Type): A derived type that is explicitly limited
	must have limited ancestor and progenitors.
	(Build_Derived_Type): Ditto.
	(Process_Full_View): Verify that explicit uses of "limited" in partial
	and full declarations are consistent.
	(Find_Ancestor_Interface): Remove function.
	(Collect_Implemented_Interfaces): New procedure used to gather all
	implemented interfaces by a type.
	(Contain_Interface): New function used to check whether an interface is
	present in a list.
	(Find_Hidden_Interface): New function used to determine whether two
	lists of interfaces constitute a set equality. If not, the first
	differing interface is returned.
	(Process_Full_View): Improve the check for the "no hidden interface"
	rule as defined by AI-396.



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

1 files changed, 31 insertions, 6 deletions

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index c126bd88e33..4a9eb8b8881 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -452,8 +452,8 @@ package body Einfo is
    --    Is_Task_Interface              Flag200
 
    --    Has_Anon_Block_Suffix          Flag201
+   --    Itype_Printed                  Flag202
 
-   --    (unused)                       Flag202
    --    (unused)                       Flag203
    --    (unused)                       Flag204
    --    (unused)                       Flag205
@@ -1877,6 +1877,7 @@ package body Einfo is
    function Is_Volatile (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
+
       if Is_Type (Id) then
          return Flag16 (Base_Type (Id));
       else
@@ -1884,6 +1885,12 @@ package body Einfo is
       end if;
    end Is_Volatile;
 
+   function Itype_Printed (Id : E) return B is
+   begin
+      pragma Assert (Is_Itype (Id));
+      return Flag202 (Id);
+   end Itype_Printed;
+
    function Kill_Elaboration_Checks (Id : E) return B is
    begin
       return Flag32 (Id);
@@ -4016,6 +4023,12 @@ package body Einfo is
       Set_Flag16 (Id, V);
    end Set_Is_Volatile;
 
+   procedure Set_Itype_Printed (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Itype (Id));
+      Set_Flag202 (Id, V);
+   end Set_Itype_Printed;
+
    procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
    begin
       Set_Flag32 (Id, V);
@@ -5722,6 +5735,7 @@ package body Einfo is
 
    function Is_Limited_Type (Id : E) return B is
       Btype : constant E := Base_Type (Id);
+      Rtype : constant E := Root_Type (Btype);
 
    begin
       if not Is_Type (Id) then
@@ -5744,11 +5758,17 @@ package body Einfo is
          return False;
 
       elsif Is_Record_Type (Btype) then
-         if Is_Limited_Record (Root_Type (Btype)) then
-            return True;
+
+         --  AI-419: limitedness is not inherited from a limited interface
+
+         if Is_Limited_Record (Rtype) then
+            return not Is_Interface (Rtype)
+              or else Is_Protected_Interface (Rtype)
+              or else Is_Synchronized_Interface (Rtype)
+              or else Is_Task_Interface (Rtype);
 
          elsif Is_Class_Wide_Type (Btype) then
-            return Is_Limited_Type (Root_Type (Btype));
+            return Is_Limited_Type (Rtype);
 
          else
             declare
@@ -5813,6 +5833,8 @@ package body Einfo is
    -- Is_Return_By_Reference_Type --
    ---------------------------------
 
+   --  Note: this predicate has disappeared from Ada 2005: see AI-318-2
+
    function Is_Return_By_Reference_Type (Id : E) return B is
       Btype : constant Entity_Id := Base_Type (Id);
 
@@ -5820,7 +5842,6 @@ package body Einfo is
       if Is_Private_Type (Btype) then
          declare
             Utyp : constant Entity_Id := Underlying_Type (Btype);
-
          begin
             if No (Utyp) then
                return False;
@@ -5834,7 +5855,10 @@ package body Einfo is
 
       elsif Is_Record_Type (Btype) then
          if Is_Limited_Record (Btype) then
-            return True;
+            return not Is_Interface (Btype)
+              or else Is_Protected_Interface (Btype)
+              or else Is_Synchronized_Interface (Btype)
+              or else Is_Task_Interface (Btype);
 
          elsif Is_Class_Wide_Type (Btype) then
             return Is_Return_By_Reference_Type (Root_Type (Btype));
@@ -6700,6 +6724,7 @@ package body Einfo is
       W ("Is_Valued_Procedure",           Flag127 (Id));
       W ("Is_Visible_Child_Unit",         Flag116 (Id));
       W ("Is_Volatile",                   Flag16  (Id));
+      W ("Itype_Printed",                 Flag202 (Id));
       W ("Kill_Elaboration_Checks",       Flag32  (Id));
       W ("Kill_Range_Checks",             Flag33  (Id));
       W ("Kill_Tag_Checks",               Flag34  (Id));