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, 129 insertions, 25 deletions

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index d02abfd52dd..8a7f003ced8 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -866,7 +866,9 @@ package body Sem_Aggr is
          Error_Msg_N ("aggregate type cannot have limited component", N);
          Explain_Limited_Type (Typ, N);
 
-      elsif Is_Limited_Type (Typ) then
+      elsif Is_Limited_Type (Typ)
+        and not Extensions_Allowed
+      then
          Error_Msg_N ("aggregate type cannot be limited", N);
          Explain_Limited_Type (Typ, N);
 
@@ -1913,7 +1915,9 @@ package body Sem_Aggr is
          Error_Msg_N ("type of extension aggregate must be tagged", N);
          return;
 
-      elsif Is_Limited_Type (Typ) then
+      elsif Is_Limited_Type (Typ)
+        and not Extensions_Allowed
+      then
          Error_Msg_N ("aggregate type cannot be limited", N);
          Explain_Limited_Type (Typ, N);
          return;
@@ -2017,7 +2021,19 @@ package body Sem_Aggr is
       --
       --  This variable is updated as a side effect of function Get_Value
 
-      procedure Add_Association (Component : Entity_Id; Expr : Node_Id);
+      Mbox_Present : Boolean := False;
+      Others_Mbox  : Boolean := False;
+      --  Variables used in case of default initialization to provide a
+      --  functionality similar to Others_Etype. Mbox_Present indicates
+      --  that the component takes its default initialization; Others_Mbox
+      --  indicates that at least one component takes its default initiali-
+      --  zation. Similar to Others_Etype, they are also updated as a side
+      --  effect of function Get_Value.
+
+      procedure Add_Association
+        (Component   : Entity_Id;
+         Expr        : Node_Id;
+         Box_Present : Boolean := False);
       --  Builds a new N_Component_Association node which associates
       --  Component to expression Expr and adds it to the new association
       --  list New_Assoc_List being built.
@@ -2064,7 +2080,11 @@ package body Sem_Aggr is
       -- Add_Association --
       ---------------------
 
-      procedure Add_Association (Component : Entity_Id; Expr : Node_Id) is
+      procedure Add_Association
+        (Component   : Entity_Id;
+         Expr        : Node_Id;
+         Box_Present : Boolean := False)
+      is
          Choice_List : constant List_Id := New_List;
          New_Assoc   : Node_Id;
 
@@ -2072,8 +2092,9 @@ package body Sem_Aggr is
          Append (New_Occurrence_Of (Component, Sloc (Expr)), Choice_List);
          New_Assoc :=
            Make_Component_Association (Sloc (Expr),
-             Choices    => Choice_List,
-             Expression => Expr);
+             Choices     => Choice_List,
+             Expression  => Expr,
+             Box_Present => Box_Present);
          Append (New_Assoc, New_Assoc_List);
       end Add_Association;
 
@@ -2174,7 +2195,37 @@ package body Sem_Aggr is
          Expr          : Node_Id := Empty;
          Selector_Name : Node_Id;
 
+         procedure Check_Non_Limited_Type;
+         --  Relax check to allow the default initialization of limited types.
+         --  For example:
+         --      record
+         --         C : Lim := (..., others => <>);
+         --      end record;
+
+         procedure Check_Non_Limited_Type is
+         begin
+            if Is_Limited_Type (Etype (Compon))
+               and then Comes_From_Source (Compon)
+               and then not In_Instance_Body
+            then
+
+               if Extensions_Allowed
+                 and then Present (Expression (Assoc))
+                 and then Nkind (Expression (Assoc)) = N_Aggregate
+               then
+                  null;
+               else
+                  Error_Msg_N
+                    ("initialization not allowed for limited types", N);
+                  Explain_Limited_Type (Etype (Compon), Compon);
+               end if;
+
+            end if;
+         end Check_Non_Limited_Type;
+
       begin
+         Mbox_Present := False;
+
          if Present (From) then
             Assoc := First (From);
          else
@@ -2186,14 +2237,6 @@ package body Sem_Aggr is
             while Present (Selector_Name) loop
                if Nkind (Selector_Name) = N_Others_Choice then
                   if Consider_Others_Choice and then No (Expr) then
-                     if Present (Others_Etype) and then
-                        Base_Type (Others_Etype) /= Base_Type (Etype (Compon))
-                     then
-                        Error_Msg_N ("components in OTHERS choice must " &
-                                     "have same type", Selector_Name);
-                     end if;
-
-                     Others_Etype := Etype (Compon);
 
                      --  We need to duplicate the expression for each
                      --  successive component covered by the others choice.
@@ -2202,10 +2245,34 @@ package body Sem_Aggr is
                      --  indispensable otherwise, because each one must be
                      --  expanded individually to preserve side-effects.
 
-                     if Expander_Active then
-                        return New_Copy_Tree (Expression (Assoc));
+                     if Box_Present (Assoc) then
+                        Others_Mbox  := True;
+                        Mbox_Present := True;
+
+                        if Expander_Active then
+                           return New_Copy_Tree (Expression (Parent (Compon)));
+                        else
+                           return Expression (Parent (Compon));
+                        end if;
                      else
-                        return Expression (Assoc);
+
+                        Check_Non_Limited_Type;
+
+                        if Present (Others_Etype) and then
+                           Base_Type (Others_Etype) /= Base_Type (Etype
+                                                                   (Compon))
+                        then
+                           Error_Msg_N ("components in OTHERS choice must " &
+                                        "have same type", Selector_Name);
+                        end if;
+
+                        Others_Etype := Etype (Compon);
+
+                        if Expander_Active then
+                           return New_Copy_Tree (Expression (Assoc));
+                        else
+                           return Expression (Assoc);
+                        end if;
                      end if;
                   end if;
 
@@ -2216,10 +2283,27 @@ package body Sem_Aggr is
                      --  components are grouped together with a "|" choice.
                      --  For instance "filed1 | filed2 => Expr"
 
-                     if Present (Next (Selector_Name)) then
-                        Expr := New_Copy_Tree (Expression (Assoc));
+                     if Box_Present (Assoc) then
+                        Mbox_Present := True;
+
+                        --  Duplicate the default expression of the component
+                        --  from the record type declaration
+
+                        if Present (Next (Selector_Name)) then
+                           Expr := New_Copy_Tree
+                                     (Expression (Parent (Compon)));
+                        else
+                           Expr := Expression (Parent (Compon));
+                        end if;
                      else
-                        Expr := Expression (Assoc);
+
+                        Check_Non_Limited_Type;
+
+                        if Present (Next (Selector_Name)) then
+                           Expr := New_Copy_Tree (Expression (Assoc));
+                        else
+                           Expr := Expression (Assoc);
+                        end if;
                      end if;
 
                      Generate_Reference (Compon, Selector_Name);
@@ -2753,7 +2837,18 @@ package body Sem_Aggr is
          Component := Node (Component_Elmt);
          Expr := Get_Value (Component, Component_Associations (N), True);
 
-         if No (Expr) then
+         if Mbox_Present and then Is_Limited_Type (Etype (Component)) then
+
+            --  In case of default initialization of a limited component we
+            --  pass the limited component to the expander. The expander will
+            --  generate calls to the corresponding initialization subprograms.
+
+            Add_Association
+              (Component   => Component,
+               Expr        => Empty,
+               Box_Present => True);
+
+         elsif No (Expr) then
             Error_Msg_NE ("no value supplied for component &!", N, Component);
          else
             Resolve_Aggr_Expr (Expr, Component);
@@ -2783,7 +2878,9 @@ package body Sem_Aggr is
             Typech := Empty;
 
             if Nkind (Selectr) = N_Others_Choice then
-               if No (Others_Etype) then
+               if No (Others_Etype)
+                  and then not Others_Mbox
+               then
                   Error_Msg_N
                     ("OTHERS must represent at least one component", Selectr);
                end if;
@@ -2804,8 +2901,10 @@ package body Sem_Aggr is
                --  component supplied by a previous expansion.
 
                if No (New_Assoc) then
+                  if Box_Present (Parent (Selectr)) then
+                     null;
 
-                  if Chars (Selectr) /= Name_uTag
+                  elsif Chars (Selectr) /= Name_uTag
                     and then Chars (Selectr) /= Name_uParent
                     and then Chars (Selectr) /= Name_uController
                   then
@@ -2827,8 +2926,13 @@ package body Sem_Aggr is
                   Typech := Base_Type (Etype (Component));
 
                elsif Typech /= Base_Type (Etype (Component)) then
-                  Error_Msg_N
-                    ("components in choice list must have same type", Selectr);
+
+                  if not Box_Present (Parent (Selectr)) then
+                     Error_Msg_N
+                       ("components in choice list must have same type",
+                        Selectr);
+                  end if;
+
                end if;
 
                Next (Selectr);