exp_ch3.ads, [...] (Add_Final_Chain): New subprogram.

2007-08-14  Thomas Quinot  <quinot@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* exp_ch3.ads, exp_ch3.adb (Add_Final_Chain): New subprogram.
	(Freeze_Array_Type, Freeze_Record_Type): For the case of a component
	type that is an anonymous access to controlled object, establish
	an associated finalization chain to avoid corrupting the global
	finalization list when a dynamically allocated object designated
	by such a component is deallocated.
	(Make_Controlling_Function_Wrappers): Create wrappers for constructor
	functions that need it, even when not marked Requires_Overriding.
	(Initialize_Tag): Replace call to has_discriminants by call to
	Is_Variable_Size_Record in the circuitry that handles the
	initialization of secondary tags.
	(Is_Variable_Size_Record): New implementation.
	(Expand_N_Object_Declaration): Suppress call to init proc if there is a
	Suppress_Initialization pragma for a derived type.
	(Is_Variable_Size_Record): New subprogram.
	(Build_Offset_To_Top_Functions): New implementation that simplifies the
	initial version of this routine and also fixes problems causing
	incomplete initialization of the table of interfaces.
	(Build_Init_Procedure): Improve the generation of code to initialize the
	the tag components of secondary dispatch tables.
	(Init_Secondary_Tags): New implementation that simplifies the previous
	version of this routine.
	(Make_DT): Add parameter to indicate when type has been frozen by an
	object declaration, for diagnostic purposes.
	(Check_Premature_Freezing): New subsidiary procedure of Make_DT, to
	diagnose attemps to freeze a subprogram when some untagged type of its
	profile is a private type whose full view has not been analyzed yet.
	(Freeze_Array_Type): Generate init proc for packed array if either
	Initialize or Normalize_Scalars is set.
	(Make_Controlling_Function_Wrappers, Make_Null_Procedure_Specs): when
	constructing the new profile, copy the null_exclusion indicator for each
	parameter, to ensure full conformance of the new body with the spec.

	* sem_type.ads, sem_type.adb (Make_Controlling_Function_Wrappers):
	Create wrappers for constructor functions that need it, even when not
	marked Requires_Overriding.
	(Covers): Handle properly designated types of anonymous access types,
	whose non-limited views are themselves incomplete types.
	(Add_Entry): Use an entity to store the abstract operation which hides
	an interpretation.
	(Binary_Op_May_Be_Hidden): Rename to Binary_Op_Interp_Has_Abstract_Op.
	(Collect_Interps): Use Empty as an actual for Abstract_Op in the
	initialization aggregate.
	(Function_Interp_May_Be_Hidden): Rename to
	Function_Interp_Has_Abstract_Op.
	(Has_Compatible_Type): Remove machinery that skips interpretations if
	they are labeled as potentially hidden by an abstract operator.
	(Has_Hidden_Interp): Rename to Has_Abstract_Op.
	(Set_May_Be_Hidden): Rename to Set_Abstract_Op.
	(Write_Overloads): Output the abstract operator if present.
	(Add_Entry): Before inserting a new entry into the interpretation table
	for a node, determine whether the entry will be disabled by an abstract
	operator.
	(Binary_Op_Interp_May_Be_Hidden): New routine.
	(Collect_Interps): Add value for flag May_Be_Hidden in initialization
	aggregate.
	(Function_Interp_May_Be_Hidden): New routine.
	(Has_Compatible_Type): Do not consider interpretations hidden by
	abstract operators when trying to determine whether two types are
	compatible.
	(Has_Hidden_Interp): New routine.
	(Set_May_Be_Hidden_Interp): New routine.
	(Write_Overloads): Write the status of flag May_Be_Hidden.

From-SVN: r127417

gcc/ada/exp_ch3.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -111,12 +111,17 @@ package Exp_Ch3 is
    --  since it would confuse any remaining processing of the freeze node.
 
    procedure Init_Secondary_Tags
-     (Typ        : Entity_Id;
-      Target     : Node_Id;
-      Stmts_List : List_Id);
-   --  Ada 2005 (AI-251): Initialize the tags of all the secondary tables
-   --  associated with the abstract interfaces of Typ. The generated code
-   --  referencing tag fields of Target is appended to Stmts_List.
+     (Typ            : Entity_Id;
+      Target         : Node_Id;
+      Stmts_List     : List_Id;
+      Fixed_Comps    : Boolean := True;
+      Variable_Comps : Boolean := True);
+   --  Ada 2005 (AI-251): Initialize the tags of the secondary dispatch tables
+   --  of Typ. The generated code referencing tag fields of Target is appended
+   --  to Stmts_List. If Fixed_Comps is True then the tag components located at
+   --  fixed positions of Target are initialized; if Variable_Comps is True
+   --  then tags components located at variable positions of Target are
+   --  initialized.
 
    function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
    --  Certain types need initialization even though there is no specific

gcc/ada/sem_type.ads

@@ -41,13 +41,13 @@ package Sem_Type is
    --  the visibility rules find such a potential ambiguity, the set of
    --  possible interpretations must be attached to the identifier, and
    --  overload resolution must be performed over the innermost enclosing
-   --  complete context. At the end of the resolution,  either a single
+   --  complete context. At the end of the resolution, either a single
    --  interpretation is found for all identifiers in the context, or else a
    --  type error (invalid type or ambiguous reference) must be signalled.
 
    --  The set of interpretations of a given name is stored in a data structure
    --  that is separate from the syntax tree, because it corresponds to
-   --  transient information.  The interpretations themselves are stored in
+   --  transient information. The interpretations themselves are stored in
    --  table All_Interp. A mapping from tree nodes to sets of interpretations
    --  called Interp_Map, is maintained by the overload resolution routines.
    --  Both these structures are initialized at the beginning of every complete
@@ -64,11 +64,15 @@ package Sem_Type is
    --  only one interpretation is present anyway.
 
    type Interp is record
-      Nam : Entity_Id;
-      Typ : Entity_Id;
+      Nam         : Entity_Id;
+      Typ         : Entity_Id;
+      Abstract_Op : Entity_Id := Empty;
    end record;
 
-   No_Interp : constant Interp := (Empty, Empty);
+   --  Entity Abstract_Op is set to the abstract operation which potentially
+   --  disables the interpretation in Ada 2005 mode.
+
+   No_Interp : constant Interp := (Empty, Empty, Empty);
 
    subtype Interp_Index is Int;
 
@@ -122,8 +126,9 @@ package Sem_Type is
    --  E is an overloadable entity, and T is its type. For constructs such
    --  as indexed expressions, the caller sets E equal to T, because the
    --  overloading comes from other fields, and the node itself has no name
-   --  to resolve. Add_One_Interp includes the semantic processing to deal
-   --  with adding entries that hide one another etc.
+   --  to resolve. Hidden denotes whether an interpretation has been disabled
+   --  by an abstract operator. Add_One_Interp includes semantic processing to
+   --  deal with adding entries that hide one another etc.
 
    --  For operators, the legality of the operation depends on the visibility
    --  of T and its scope. If the operator is an equality or comparison, T is
@@ -172,7 +177,7 @@ package Sem_Type is
       I1, I2 : Interp_Index;
       Typ    : Entity_Id)
       return   Interp;
-   --  If more than one interpretation  of a name in a call is legal, apply
+   --  If more than one interpretation of a name in a call is legal, apply
    --  preference rules (universal types first) and operator visibility in
    --  order to remove ambiguity. I1 and I2 are the first two interpretations
    --  that are compatible with the context, but there may be others.
@@ -216,19 +221,22 @@ package Sem_Type is
    --  interpretations is universal, choose the non-universal one. If either
    --  node is overloaded, find single common interpretation.
 
-   function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
-   --  Checks whether T1 is any subtype of T2 directly or indirectly. Applies
-   --  only to scalar subtypes ???
-
    function Is_Ancestor (T1, T2 : Entity_Id) return Boolean;
    --  T1 is a tagged type (not class-wide). Verify that it is one of the
    --  ancestors of type T2 (which may or not be class-wide)
 
-   function Operator_Matches_Spec (Op,  New_S : Entity_Id) return Boolean;
+   function Is_Subtype_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
+   --  Checks whether T1 is any subtype of T2 directly or indirectly. Applies
+   --  only to scalar subtypes ???
+
+   function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean;
    --  Used to resolve subprograms renaming operators, and calls to user
    --  defined operators. Determines whether a given operator Op, matches
    --  a specification, New_S.
 
+   procedure Set_Abstract_Op (I : Interp_Index; V : Entity_Id);
+   --  Set the abstract operation field of an interpretation
+
    function Valid_Comparison_Arg (T : Entity_Id) return Boolean;
    --  A valid argument to an ordering operator must be a discrete type, a
    --  real type, or a one dimensional array with a discrete component type.