2003-11-13 Vincent Celier <celier@gnat.com>

	* 5bml-tgt.adb (Build_Dynamic_Library): Use
	Osint.Include_Dir_Default_Prefix instead of
	Sdefault.Include_Dir_Default_Name.

	* gnatlbr.adb: Update Copyright notice
	(Gnatlbr): : Use Osint.Include_Dir_Default_Prefix instead of
	Sdefault.Include_Dir_Default_Name and Osint.Object_Dir_Default_Prefix
	instead of Sdefault.Object_Dir_Default_Name

	* gnatlink.adb:
	(Process_Binder_File): Never suppress the option following -Xlinker

	* mdll-utl.adb:
	(Gcc): Use Osint.Object_Dir_Default_Prefix instead of
	Sdefault.Object_Dir_Default_Name.

	* osint.ads, osint.adb:
	(Include_Dir_Default_Prefix, Object_Dir_Default_Prefix): New functions
	Minor reformatting.

	* vms_conv.ads: Minor reformating
	Remove GNAT STANDARD and GNAT PSTA

	* vms_conv.adb:
	Allow GNAT MAKE to have several files on the command line.
	(Init_Object_Dirs): Use Osint.Object_Dir_Default_Prefix instead of
	Sdefault.Object_Dir_Default_Name.
	Minor Reformating
	Remove data for GNAT STANDARD

	* vms_data.ads:
	Add new compiler qualifier /PRINT_STANDARD (-gnatS)
	Remove data for GNAT STANDARD
	Remove options and documentation for -gnatwb/-gnatwB: these warning
	options no longer exist.

2003-11-13  Ed Falis  <falis@gnat.com>

	* 5zthrini.adb: (Init_RTS): Made visible

	* 5zthrini.adb:
	(Register): Removed unnecessary call to taskVarGet that checked whether
	 an ATSD was already set as a task var for the argument thread.

	* s-thread.adb:
	Updated comment to reflect that this is a VxWorks version
	Added context clause for System.Threads.Initialization
	Added call to System.Threads.Initialization.Init_RTS

2003-11-13  Jerome Guitton  <guitton@act-europe.fr>

	* 5zthrini.adb:
	(Init_RTS): New procedure, for the initialization of the run-time lib.

	* s-thread.adb:
	Remove dependancy on System.Init, so that this file can be used in the
	AE653 sequential run-time lib.

2003-11-13  Robert Dewar  <dewar@gnat.com>

	* bindgen.adb: Minor reformatting

2003-11-13  Ed Schonberg  <schonberg@gnat.com>

	* checks.adb:
	(Apply_Discriminant_Check): Do no apply check if target type is derived
	from source type with no applicable constraint.

	* lib-writ.adb:
	(Ensure_System_Dependency): Do not apply the style checks that may have
	been specified for the main unit.

	* sem_ch8.adb:
	(Find_Selected_Component): Further improvement in error message, with
	RM reference.

	* sem_res.adb:
	(Resolve): Handle properly the case of an illegal overloaded protected
	procedure.

2003-11-13  Javier Miranda  <miranda@gnat.com>

	* exp_aggr.adb:
	(Has_Default_Init_Comps): New function to check the presence of
	default initialization in an aggregate.
	(Build_Record_Aggr_Code): Recursively expand the ancestor in case of
	extension aggregate of a limited record. In addition, a new formal
	was added to do not initialize the record controller (if any) during
	this recursive expansion of ancestors.
	(Init_Controller): Add support for limited record components.
	(Expand_Record_Aggregate): In case of default initialized components
	convert the aggregate into a set of assignments.

	* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Update the comment
	describing the new syntax.
	Nothing else needed to be done because this subprogram delegates part of
	its work to P_Precord_Or_Array_Component_Association.
	(P_Record_Or_Array_Component_Association): Give support to the new
	syntax for default initialization of components.

	* sem_aggr.adb:
	(Resolve_Aggregate): Relax the strictness of the frontend in case of
	limited aggregates.
	(Resolve_Record_Aggregate): Give support to default initialized
	components.
	(Get_Value): In case of default initialized components, duplicate
	the corresponding default expression (from the record type
	declaration). In case of default initialization in the *others*
	choice, do not check that all components have the same type.
	(Resolve_Extension_Aggregate): Give support to limited extension
	aggregates.

	* sem_ch3.adb:
	(Check_Initialization): Relax the strictness of the front-end in case
	of aggregate and extension aggregates. This test is now done in
	Get_Value in a per-component manner.

	* sem_ch4.adb (Analyze_Allocator): Don't post an error if the
	expression corresponds to a limited aggregate. This test is now done
	in Get_Value.

	* sinfo.ads, sinfo.adb (N_Component_Association): Addition of
	Box_Present flag.

	* sprint.adb (Sprint_Node_Actual): Modified to print an mbox if
	present in an N_Component_Association node

2003-11-13  Thomas Quinot  <quinot@act-europe.fr>

	* sem_ch9.adb (Analyze_Accept_Statement): A procedure hides a
	type-conformant entry only if they are homographs.

2003-11-13  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated


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

1 files changed, 127 insertions, 26 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 0985ead93a7..e2413bbd4f9 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -70,6 +70,10 @@ package body Exp_Aggr is
    --  statement of variant part will usually be small and probably in near
    --  sorted order.
 
+   function Has_Default_Init_Comps (N : Node_Id) return Boolean;
+   --  N is an aggregate (record or array). Checks the presence of
+   --  default initialization (<>) in any component.
+
    ------------------------------------------------------
    -- Local subprograms for Record Aggregate Expansion --
    ------------------------------------------------------
@@ -97,12 +101,13 @@ package body Exp_Aggr is
    --  assignments component per component.
 
    function Build_Record_Aggr_Code
-     (N      : Node_Id;
-      Typ    : Entity_Id;
-      Target : Node_Id;
-      Flist  : Node_Id   := Empty;
-      Obj    : Entity_Id := Empty)
-      return   List_Id;
+     (N                             : Node_Id;
+      Typ                           : Entity_Id;
+      Target                        : Node_Id;
+      Flist                         : Node_Id   := Empty;
+      Obj                           : Entity_Id := Empty;
+      Is_Limited_Ancestor_Expansion : Boolean   := False)
+      return List_Id;
    --  N is an N_Aggregate or a N_Extension_Aggregate. Typ is the type
    --  of the aggregate. Target is an expression containing the
    --  location on which the component by component assignments will
@@ -113,6 +118,8 @@ package body Exp_Aggr is
    --  object declaration and dynamic allocation cases, it contains
    --  an entity that allows to know if the value being created needs to be
    --  attached to the final list in case of pragma finalize_Storage_Only.
+   --  Is_Limited_Ancestor_Expansion indicates that the function has been
+   --  called recursively to expand the limited ancestor to avoid copying it.
 
    function Has_Mutable_Components (Typ : Entity_Id) return Boolean;
    --  Return true if one of the component is of a discriminated type with
@@ -1269,12 +1276,13 @@ package body Exp_Aggr is
    ----------------------------
 
    function Build_Record_Aggr_Code
-     (N      : Node_Id;
-      Typ    : Entity_Id;
-      Target : Node_Id;
-      Flist  : Node_Id   := Empty;
-      Obj    : Entity_Id := Empty)
-      return   List_Id
+     (N                             : Node_Id;
+      Typ                           : Entity_Id;
+      Target                        : Node_Id;
+      Flist                         : Node_Id   := Empty;
+      Obj                           : Entity_Id := Empty;
+      Is_Limited_Ancestor_Expansion : Boolean   := False)
+      return List_Id
    is
       Loc     : constant Source_Ptr := Sloc (N);
       L       : constant List_Id    := New_List;
@@ -1540,20 +1548,50 @@ package body Exp_Aggr is
              Selector_Name => Make_Identifier (Loc, Name_uController));
          Set_Assignment_OK (Ref);
 
-         if Init_Pr then
-            Append_List_To (L,
-              Build_Initialization_Call (Loc,
-                Id_Ref       => Ref,
-                Typ          => RTE (RE_Record_Controller),
-                In_Init_Proc => Within_Init_Proc));
-         end if;
+         --  Give support to default initialization of limited types and
+         --  components
 
-         Append_To (L,
-           Make_Procedure_Call_Statement (Loc,
-             Name =>
-               New_Reference_To (Find_Prim_Op (RTE (RE_Record_Controller),
-                 Name_Initialize), Loc),
-             Parameter_Associations => New_List (New_Copy_Tree (Ref))));
+         if (Nkind (Target) = N_Identifier
+             and then Is_Limited_Type (Etype (Target)))
+           or else (Nkind (Target) = N_Selected_Component
+                    and then Is_Limited_Type (Etype (Selector_Name (Target))))
+           or else (Nkind (Target) = N_Unchecked_Type_Conversion
+                    and then Is_Limited_Type (Etype (Target)))
+         then
+
+            if Init_Pr then
+               Append_List_To (L,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref       => Ref,
+                   Typ          => RTE (RE_Limited_Record_Controller),
+                   In_Init_Proc => Within_Init_Proc));
+            end if;
+
+            Append_To (L,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  New_Reference_To
+                         (Find_Prim_Op (RTE (RE_Limited_Record_Controller),
+                    Name_Initialize), Loc),
+                Parameter_Associations => New_List (New_Copy_Tree (Ref))));
+
+         else
+            if Init_Pr then
+               Append_List_To (L,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref       => Ref,
+                   Typ          => RTE (RE_Record_Controller),
+                   In_Init_Proc => Within_Init_Proc));
+            end if;
+
+            Append_To (L,
+              Make_Procedure_Call_Statement (Loc,
+                Name =>
+                  New_Reference_To (Find_Prim_Op (RTE (RE_Record_Controller),
+                    Name_Initialize), Loc),
+                Parameter_Associations => New_List (New_Copy_Tree (Ref))));
+
+         end if;
 
          Append_To (L,
            Make_Attach_Call (
@@ -1648,6 +1686,21 @@ package body Exp_Aggr is
                   Check_Ancestor_Discriminants (Entity (A));
                end if;
 
+            --  If the ancestor part is a limited type, a recursive call
+            --  expands the ancestor.
+
+            elsif Is_Limited_Type (Etype (A)) then
+               Ancestor_Is_Expression := True;
+
+               Append_List_To (Start_L,
+                  Build_Record_Aggr_Code (
+                    N                             => Expression (A),
+                    Typ                           => Etype (Expression (A)),
+                    Target                        => Target,
+                    Flist                         => Flist,
+                    Obj                           => Obj,
+                    Is_Limited_Ancestor_Expansion => True));
+
             --  If the ancestor part is an expression "E", we generate
             --     T(tmp) := E;
 
@@ -1767,6 +1820,22 @@ package body Exp_Aggr is
       while Present (Comp) loop
          Selector  := Entity (First (Choices (Comp)));
 
+         --  Default initialization of a limited component
+
+         if Box_Present (Comp)
+            and then Is_Limited_Type (Etype (Selector))
+         then
+            Append_List_To (L,
+              Build_Initialization_Call (Loc,
+                Id_Ref => Make_Selected_Component (Loc,
+                            Prefix => New_Copy_Tree (Target),
+                            Selector_Name => New_Occurrence_Of (Selector,
+                                                                Loc)),
+                Typ    => Etype (Selector)));
+
+            goto Next_Comp;
+         end if;
+
          --  ???
 
          if Ekind (Selector) /= E_Discriminant
@@ -1900,6 +1969,8 @@ package body Exp_Aggr is
             end;
          end if;
 
+         <<Next_Comp>>
+
          Next (Comp);
       end loop;
 
@@ -1997,7 +2068,9 @@ package body Exp_Aggr is
       --  In the Has_Controlled component case, all the intermediate
       --  controllers must be initialized
 
-      if Has_Controlled_Component (Typ) then
+      if Has_Controlled_Component (Typ)
+        and not Is_Limited_Ancestor_Expansion
+      then
          declare
             Inner_Typ : Entity_Id;
             Outer_Typ : Entity_Id;
@@ -4082,6 +4155,9 @@ package body Exp_Aggr is
       then
          Convert_To_Assignments (N, Typ);
 
+      elsif Has_Default_Init_Comps (N) then
+         Convert_To_Assignments (N, Typ);
+
       elsif Has_Delayed_Nested_Aggregate_Or_Tagged_Comps then
          Convert_To_Assignments (N, Typ);
 
@@ -4402,6 +4478,31 @@ package body Exp_Aggr is
       end if;
    end Expand_Record_Aggregate;
 
+   ----------------------------
+   -- Has_Default_Init_Comps --
+   ----------------------------
+
+   function Has_Default_Init_Comps (N : Node_Id) return Boolean is
+      Comps  : constant List_Id := Component_Associations (N);
+      C      : Node_Id;
+   begin
+      pragma Assert (Nkind (N) = N_Aggregate
+                     or else Nkind (N) = N_Extension_Aggregate);
+      if No (Comps) then
+         return False;
+      end if;
+
+      C := First (Comps);
+      while Present (C) loop
+         if Box_Present (C) then
+            return True;
+         end if;
+
+         Next (C);
+      end loop;
+      return False;
+   end Has_Default_Init_Comps;
+
    --------------------------
    -- Is_Delayed_Aggregate --
    --------------------------