committed: Ada updates

Arnaud Charlet charlet@ACT-Europe.FR
Mon Dec 8 10:34:00 GMT 2003


Tested on x86-linux

--
2003-12-08  Jerome Guitton  <guitton@act-europe.fr>

	* 5ytiitho.adb, 5zthrini.adb, 5ztiitho.adb, i-vthrea.adb,
	i-vthrea.ads, s-tpae65.adb, s-tpae65.ads: Cleanup: Remove a bunch of
	obsolete files.

	* Makefile.in: (rts-ravenscar): Generate an empty libgnat.a.
	(rts-zfp): Ditto.

2003-12-08  Robert Dewar  <dewar@gnat.com>

	* 7sintman.adb: Minor reformatting

	* bindgen.adb: Configurable_Run_Time mode no longer suppresses the
	standard linker options to get standard libraries linked. We now plan
	to provide dummy versions of these libraries to match the appropriate
	configurable run-time (e.g. if a library is not needed at all, provide
	a dummy empty library).

	* targparm.ads: Configurable_Run_Time mode no longer affects linker
	options (-L parameters and standard libraries). What we plan to do is
	to provide dummy libraries where the libraries are not required.

	* gnatbind.adb: Minor comment improvement

2003-12-08  Javier Miranda  <miranda@gnat.com>

	* exp_aggr.adb (Build_Record_Aggr_Code): Do not remove the expanded
	aggregate in the parent. Otherwise constants with limited aggregates
	are not supported. Add new formal to pass the component type (Ctype).
	It is required to call the corresponding IP subprogram in case of
	default initialized components.
	(Gen_Assign): In case of default-initialized component, generate a
	call to the IP subprogram associated with the component.
	(Build_Record_Aggr_Code): Remove the aggregate from the parent in case
	of aggregate with default initialized components.
	(Has_Default_Init_Comps): Improve implementation to recursively check
	all the present expressions.

	* exp_ch3.ads, exp_ch3.adb (Build_Initialization_Call): Add new formal
	to indicate that the initialization call corresponds to a
	default-initialized component of an aggregate.
	In case of default initialized aggregate with tasks this parameter is
	used to generate a null string (this is just a workaround that must be
	improved later). In case of discriminants, this parameter is used to
	generate a selected component node that gives access to the discriminant
	value.

	* exp_ch9.ads, exp_ch9.adb (Build_Task_Allocate_Block_With_Stmts): New
	subprogram, based on Build_Task_Allocate_Block, but adapted to expand
	allocated aggregates with default-initialized components.

	* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Improve error message if
	the box notation is used in positional aggregates.

2003-12-08  Samuel Tardieu  <tardieu@act-europe.fr>

	* lib.ads: Fix typo in comment

2003-12-08  Vincent Celier  <celier@gnat.com>

	* prj.adb (Project_Empty): New component Unkept_Comments
	(Scan): Remove procedure; moved to Prj.Err.

	* prj.ads (Project_Data): New Boolean component Unkept_Comments
	(Scan): Remove procedure; moved to Prj.Err.

	* prj-dect.adb: Manage comments for the different declarations.

	* prj-part.adb (With_Record): New component Node
	(Parse): New Boolean parameter Store_Comments, defaulted to False.
	Set the scanner to return ends of line and comments as tokens, if
	Store_Comments is True.
	(Pre_Parse_Context_Clause): Create the N_With_Clause nodes so that
	comments are associated with these nodes. Store the node IDs in the
	With_Records.
	(Post_Parse_Context_Clause): Use the N_With_Clause nodes stored in the
	With_Records.
	(Parse_Single_Project): Call Pre_Parse_Context_Clause before creating
	the N_Project node. Call Tree.Save and Tree.Reset before scanning the
	current project. Call Tree.Restore afterwards. Set the various nodes
	for comment storage (Next_End, End_Of_Line, Previous_Line,
	Previous_End).

	* prj-part.ads (Parse): New Boolean parameter Store_Comments,
	defaulted to False.

	* prj-pp.adb (Write_String): New Boolean parameter Truncated, defaulted
	to False. When Truncated is True, truncate the string, never go to the
	next line.
	(Write_End_Of_Line_Comment): New procedure
	(Print): Process comments for nodes N_With_Clause,
	N_Package_Declaration, N_String_Type_Declaration,
	N_Attribute_Declaration, N_Typed_Variable_Declaration,
	N_Variable_Declaration, N_Case_Construction, N_Case_Item.
	Process nodes N_Comment.

	* prj-tree.ads, prj-tree.adb (Default_Project_Node): If it is a node
	without comments and there are some comments, set the flag
	Unkept_Comments to True.
	(Scan): If there are comments, set the flag Unkept_Comments to True and
	clear the comments.
	(Project_Node_Kind): Add enum values N_Comment_Zones, N_Comment
	(Next_End_Nodes: New table
	(Comment_Zones_Of): New function
	(Scan): New procedure; moved from Prj. Accumulate comments in the
	Comments table and set end of line comments, comments after, after end
	and before end.
	(Add_Comments): New procedure
	(Save, Restore, Seset_State): New procedures
	(There_Are_Unkept_Comments): New function
	(Set_Previous_Line_Node, Set_Previous_End_Node): New procedures
	(Set_End_Of_Line, Set_Next_End_Node, Remove_Next_End_Node): New
	procedures.
	(First_Comment_After, First_Comment_After_End): New functions
	(First_Comment_Before, First_Comment_Before_End): New functions
	(Next_Comment): New function
	(End_Of_Line_Comment, Follows_Empty_Line,
	Is_Followed_By_Empty_Line): New functions
	(Set_First_Comment_After, Set_First_Comment_After_End): New procedures
	(Set_First_Comment_Before, Set_First_Comment_Before_End): New procedures
	(Set_Next_Comment): New procedure
	(Default_Project_Node): Associate comment before if the node can store
	comments.

	* scans.ads (Token_Type): New enumeration value Tok_Comment
	(Comment_Id): New global variable

	* scng.ads, scng.adb (Comment_Is_Token): New Boolean global variable,
	defaulted to False.
	(Scan): Store position of start of comment. If comments are tokens, set
	Comment_Id and set Token to Tok_Comment when scanning a comment.
	(Set_Comment_As_Token): New procedure

	* sinput-p.adb: Update Copyright notice
	(Source_File_Is_Subunit): Call Prj.Err.Scanner.Scan instead of Prj.Scan
	that no longer exists.

2003-12-08  Javier Miranda  <miranda@gnat.com>

	* sem_aggr.adb: Add dependence on Exp_Tss package
	Correct typo in comment
	(Resolve_Aggregate): In case of array aggregates set the estimated
	type of the aggregate before calling resolve. This is needed to know
	the name of the corresponding IP in case of limited array aggregates.
	(Resolve_Array_Aggregate): Delay the resolution to the expansion phase
	in case of default initialized array components.

	* sem_ch12.adb (Analyze_Formal_Object_Declaration): Allow limited
	types. Required to give support to limited aggregates in generic
	formals.

2003-12-08  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch3.adb (Check_Initialization): For legality purposes, an
	inlined body functions like an instantiation.
	(Decimal_Fixed_Point_Declaration): Do not set kind of first subtype
	until bounds are analyzed, to diagnose premature use of type.

	* sem_util.adb (Wrong_Type): Improve error message when the type of
	the expression is used prematurely.

2003-12-08  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated
--
Index: 7sintman.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/7sintman.adb,v
retrieving revision 1.7
diff -u -p -r1.7 7sintman.adb
--- 7sintman.adb	5 Dec 2003 10:24:04 -0000	1.7
+++ 7sintman.adb	8 Dec 2003 10:31:49 -0000
@@ -152,7 +152,7 @@ begin
 
       function State (Int : Interrupt_ID) return Character;
       pragma Import (C, State, "__gnat_get_interrupt_state");
-      --  Get interrupt state.  Defined in a-init.c
+      --  Get interrupt state. Defined in a-init.c
       --  The input argument is the interrupt number,
       --  and the result is one of the following:
 
@@ -178,9 +178,9 @@ begin
       act.sa_flags := SA_SIGINFO;
 
       --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
-      --  number argument to the handler when it is called.  The set of extra
+      --  number argument to the handler when it is called. The set of extra
       --  parameters typically includes a pointer to a structure describing
-      --  the interrupted context.  Although the Notify_Exception handler does
+      --  the interrupted context. Although the Notify_Exception handler does
       --  not use this information, it is actually required for the GCC/ZCX
       --  exception propagation scheme because on some targets (at least
       --  alpha-tru64), the structure contents are not even filled when this
Index: bindgen.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bindgen.adb,v
retrieving revision 1.16
diff -u -p -r1.16 bindgen.adb
--- bindgen.adb	14 Nov 2003 10:24:42 -0000	1.16
+++ bindgen.adb	8 Dec 2003 10:31:49 -0000
@@ -1774,22 +1774,18 @@ package body Bindgen is
          end if;
       end loop;
 
-      --  Add a "-Ldir" for each directory in the object path. We skip this
-      --  in Configurable_Run_Time mode, where we want more precise control
-      --  of exactly what goes into the resulting object file
-
-      if not Configurable_Run_Time_Mode then
-         for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
-            declare
-               Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J);
-            begin
-               Name_Len := 0;
-               Add_Str_To_Name_Buffer ("-L");
-               Add_Str_To_Name_Buffer (Dir.all);
-               Write_Linker_Option;
-            end;
-         end loop;
-      end if;
+      --  Add a "-Ldir" for each directory in the object path
+
+      for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
+         declare
+            Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J);
+         begin
+            Name_Len := 0;
+            Add_Str_To_Name_Buffer ("-L");
+            Add_Str_To_Name_Buffer (Dir.all);
+            Write_Linker_Option;
+         end;
+      end loop;
 
       --  Sort linker options
 
@@ -1845,7 +1841,7 @@ package body Bindgen is
       --  files. The reason for this decision is that libraries referenced
       --  by internal routines may reference these standard library entries.
 
-      if not (Configurable_Run_Time_Mode or else Opt.No_Stdlib) then
+      if not Opt.No_Stdlib then
          Name_Len := 0;
 
          if Opt.Shared_Libgnat then
Index: exp_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_aggr.adb,v
retrieving revision 1.10
diff -u -p -r1.10 exp_aggr.adb
--- exp_aggr.adb	20 Nov 2003 09:53:58 -0000	1.10
+++ exp_aggr.adb	8 Dec 2003 10:31:50 -0000
@@ -33,6 +33,7 @@ with Expander; use Expander;
 with Exp_Util; use Exp_Util;
 with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch7;  use Exp_Ch7;
+with Exp_Ch9;  use Exp_Ch9;
 with Freeze;   use Freeze;
 with Hostparm; use Hostparm;
 with Itypes;   use Itypes;
@@ -170,6 +171,7 @@ package body Exp_Aggr is
 
    function Build_Array_Aggr_Code
      (N           : Node_Id;
+      Ctype       : Entity_Id;
       Index       : Node_Id;
       Into        : Node_Id;
       Scalar_Comp : Boolean;
@@ -397,6 +399,7 @@ package body Exp_Aggr is
 
    function Build_Array_Aggr_Code
      (N           : Node_Id;
+      Ctype       : Entity_Id;
       Index       : Node_Id;
       Into        : Node_Id;
       Scalar_Comp : Boolean;
@@ -430,6 +433,9 @@ package body Exp_Aggr is
       --     Into (Indices, Ind) := Expr;
       --
       --  Otherwise we call Build_Code recursively.
+      --
+      --  Ada0Y (AI-287): In case of default initialized component, Expr is
+      --  empty and we generate a call to the corresponding IP subprogram.
 
       function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id;
       --  Nodes L and H must be side-effect free expressions.
@@ -656,7 +662,13 @@ package body Exp_Aggr is
             Res : List_Id;
 
          begin
-            if Nkind (Parent (Expr)) = N_Component_Association
+            --  Ada0Y (AI-287): Do nothing else in case of default initialized
+            --  component
+
+            if not Present (Expr) then
+               return Lis;
+
+            elsif Nkind (Parent (Expr)) = N_Component_Association
               and then Present (Loop_Actions (Parent (Expr)))
             then
                Append_List (Lis, Loop_Actions (Parent (Expr)));
@@ -692,15 +704,20 @@ package body Exp_Aggr is
                F := Find_Final_List (Current_Scope);
             end if;
          else
-            F := 0;
+            F := Empty;
          end if;
 
          if Present (Next_Index (Index)) then
             return
               Add_Loop_Actions (
                 Build_Array_Aggr_Code
-                  (Expr, Next_Index (Index),
-                   Into, Scalar_Comp, New_Indices, F));
+                  (N           => Expr,
+                   Ctype       => Ctype,
+                   Index       => Next_Index (Index),
+                   Into        => Into,
+                   Scalar_Comp => Scalar_Comp,
+                   Indices     => New_Indices,
+                   Flist       => F));
          end if;
 
          --  If we get here then we are at a bottom-level (sub-)aggregate
@@ -713,7 +730,12 @@ package body Exp_Aggr is
 
          Set_Assignment_OK (Indexed_Comp);
 
-         if Nkind (Expr) = N_Qualified_Expression then
+         --  Ada0Y (AI-287): In case of default initialized component, Expr
+         --  is not present (and therefore we also initialize Expr_Q to empty)
+
+         if not Present (Expr) then
+            Expr_Q := Empty;
+         elsif Nkind (Expr) = N_Qualified_Expression then
             Expr_Q := Expression (Expr);
          else
             Expr_Q := Expr;
@@ -723,34 +745,49 @@ package body Exp_Aggr is
            and then Etype (N) /= Any_Composite
          then
             Comp_Type := Component_Type (Etype (N));
+            pragma Assert (Comp_Type = Ctype); --  AI-287
 
          elsif Present (Next (First (New_Indices))) then
 
-            --  This is a multidimensional array. Recover the component
-            --  type from the outermost aggregate, because subaggregates
-            --  do not have an assigned type.
+            --  Ada0Y (AI-287): Do nothing in case of default initialized
+            --  component because we have received the component type in
+            --  the formal parameter Ctype.
+            --  ??? I have added some assert pragmas to check if this new
+            --      formal can be used to replace this code in all cases.
+
+            if Present (Expr) then
+
+               --  This is a multidimensional array. Recover the component
+               --  type from the outermost aggregate, because subaggregates
+               --  do not have an assigned type.
 
-            declare
-               P : Node_Id := Parent (Expr);
+               declare
+                  P : Node_Id := Parent (Expr);
 
-            begin
-               while Present (P) loop
+               begin
+                  while Present (P) loop
 
-                  if Nkind (P) = N_Aggregate
-                    and then Present (Etype (P))
-                  then
-                     Comp_Type := Component_Type (Etype (P));
-                     exit;
+                     if Nkind (P) = N_Aggregate
+                       and then Present (Etype (P))
+                     then
+                        Comp_Type := Component_Type (Etype (P));
+                        exit;
 
-                  else
-                     P := Parent (P);
-                  end if;
-               end loop;
-            end;
+                     else
+                        P := Parent (P);
+                     end if;
+                  end loop;
+                  pragma Assert (Comp_Type = Ctype); --  AI-287
+               end;
+            end if;
          end if;
 
-         if Nkind (Expr_Q) = N_Aggregate
-           or else Nkind (Expr_Q) = N_Extension_Aggregate
+         --  Ada0Y (AI-287): We only analyze the expression in case of non
+         --  default initialized components (otherwise Expr_Q is not present)
+
+         if Present (Expr_Q)
+           and then (Nkind (Expr_Q) = N_Aggregate
+                     or else Nkind (Expr_Q) = N_Extension_Aggregate)
          then
             --  At this stage the Expression may not have been
             --  analyzed yet because the array aggregate code has not
@@ -771,59 +808,73 @@ package body Exp_Aggr is
             end if;
          end if;
 
-         --  Now generate the assignment with no associated controlled
-         --  actions since the target of the assignment may not have
-         --  been initialized, it is not possible to Finalize it as
-         --  expected by normal controlled assignment. The rest of the
-         --  controlled actions are done manually with the proper
-         --  finalization list coming from the context.
+         --  Ada0Y (AI-287): In case of default initialized component, call
+         --  the initialization subprogram associated with the component type
 
-         A :=
-           Make_OK_Assignment_Statement (Loc,
-             Name       => Indexed_Comp,
-             Expression => New_Copy_Tree (Expr));
+         if not Present (Expr) then
 
-         if Present (Comp_Type) and then Controlled_Type (Comp_Type) then
-            Set_No_Ctrl_Actions (A);
-         end if;
+            Append_List_To (L,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref            => Indexed_Comp,
+                   Typ               => Ctype,
+                   With_Default_Init => True));
 
-         Append_To (L, A);
+         else
 
-         --  Adjust the tag if tagged (because of possible view
-         --  conversions), unless compiling for the Java VM
-         --  where tags are implicit.
+            --  Now generate the assignment with no associated controlled
+            --  actions since the target of the assignment may not have
+            --  been initialized, it is not possible to Finalize it as
+            --  expected by normal controlled assignment. The rest of the
+            --  controlled actions are done manually with the proper
+            --  finalization list coming from the context.
 
-         if Present (Comp_Type)
-           and then Is_Tagged_Type (Comp_Type)
-           and then not Java_VM
-         then
             A :=
               Make_OK_Assignment_Statement (Loc,
-                Name =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>  New_Copy_Tree (Indexed_Comp),
-                    Selector_Name =>
-                      New_Reference_To (Tag_Component (Comp_Type), Loc)),
-
-                Expression =>
-                  Unchecked_Convert_To (RTE (RE_Tag),
-                    New_Reference_To (
-                      Access_Disp_Table (Comp_Type), Loc)));
+                Name       => Indexed_Comp,
+                Expression => New_Copy_Tree (Expr));
+
+            if Present (Comp_Type) and then Controlled_Type (Comp_Type) then
+               Set_No_Ctrl_Actions (A);
+            end if;
 
             Append_To (L, A);
-         end if;
 
-         --  Adjust and Attach the component to the proper final list
-         --  which can be the controller of the outer record object or
-         --  the final list associated with the scope
+            --  Adjust the tag if tagged (because of possible view
+            --  conversions), unless compiling for the Java VM
+            --  where tags are implicit.
 
-         if Present (Comp_Type)  and then Controlled_Type (Comp_Type) then
-            Append_List_To (L,
-              Make_Adjust_Call (
-                Ref         => New_Copy_Tree (Indexed_Comp),
-                Typ         => Comp_Type,
-                Flist_Ref   => F,
-                With_Attach => Make_Integer_Literal (Loc, 1)));
+            if Present (Comp_Type)
+              and then Is_Tagged_Type (Comp_Type)
+              and then not Java_VM
+            then
+               A :=
+                 Make_OK_Assignment_Statement (Loc,
+                   Name =>
+                     Make_Selected_Component (Loc,
+                       Prefix =>  New_Copy_Tree (Indexed_Comp),
+                       Selector_Name =>
+                         New_Reference_To (Tag_Component (Comp_Type), Loc)),
+
+                   Expression =>
+                     Unchecked_Convert_To (RTE (RE_Tag),
+                       New_Reference_To (
+                         Access_Disp_Table (Comp_Type), Loc)));
+
+               Append_To (L, A);
+            end if;
+
+            --  Adjust and Attach the component to the proper final list
+            --  which can be the controller of the outer record object or
+            --  the final list associated with the scope
+
+            if Present (Comp_Type)  and then Controlled_Type (Comp_Type) then
+               Append_List_To (L,
+                 Make_Adjust_Call (
+                   Ref         => New_Copy_Tree (Indexed_Comp),
+                   Typ         => Comp_Type,
+                   Flist_Ref   => F,
+                   With_Attach => Make_Integer_Literal (Loc, 1)));
+            end if;
          end if;
 
          return Add_Loop_Actions (L);
@@ -857,21 +908,29 @@ package body Exp_Aggr is
          if Empty_Range (L, H) then
             Append_To (S, Make_Null_Statement (Loc));
 
-            --  The expression must be type-checked even though no component
-            --  of the aggregate will have this value. This is done only for
-            --  actual components of the array, not for subaggregates. Do the
-            --  check on a copy, because the expression may be shared among
-            --  several choices, some of which might be non-null.
-
-            if Present (Etype (N))
-              and then Is_Array_Type (Etype (N))
-              and then No (Next_Index (Index))
-            then
-               Expander_Mode_Save_And_Set (False);
-               Tcopy := New_Copy_Tree (Expr);
-               Set_Parent (Tcopy, N);
-               Analyze_And_Resolve (Tcopy, Component_Type (Etype (N)));
-               Expander_Mode_Restore;
+            --  Ada0Y (AI-287): Nothing else need to be done in case of
+            --  default initialized component
+
+            if not Present (Expr) then
+               null;
+
+            else
+               --  The expression must be type-checked even though no component
+               --  of the aggregate will have this value. This is done only for
+               --  actual components of the array, not for subaggregates. Do
+               --  the check on a copy, because the expression may be shared
+               --  among several choices, some of which might be non-null.
+
+               if Present (Etype (N))
+                 and then Is_Array_Type (Etype (N))
+                 and then No (Next_Index (Index))
+               then
+                  Expander_Mode_Save_And_Set (False);
+                  Tcopy := New_Copy_Tree (Expr);
+                  Set_Parent (Tcopy, N);
+                  Analyze_And_Resolve (Tcopy, Component_Type (Etype (N)));
+                  Expander_Mode_Restore;
+               end if;
             end if;
 
             return S;
@@ -891,6 +950,7 @@ package body Exp_Aggr is
            and then Local_Compile_Time_Known_Value (H)
            and then Local_Expr_Value (H) - Local_Expr_Value (L) <= 2
          then
+
             Append_List_To (S, Gen_Assign (New_Copy_Tree (L), Expr));
             Append_List_To (S, Gen_Assign (Add (1, To => L), Expr));
 
@@ -1084,7 +1144,8 @@ package body Exp_Aggr is
       Expr   : Node_Id;
       Typ    : Entity_Id;
 
-      Others_Expr : Node_Id   := Empty;
+      Others_Expr         : Node_Id := Empty;
+      Others_Mbox_Present : Boolean := False;
 
       Aggr_L : constant Node_Id := Low_Bound (Aggregate_Bounds (N));
       Aggr_H : constant Node_Id := High_Bound (Aggregate_Bounds (N));
@@ -1096,8 +1157,8 @@ package body Exp_Aggr is
       Aggr_High : constant Node_Id := Duplicate_Subexpr_No_Checks (Aggr_H);
       --  After Duplicate_Subexpr these are side-effect free.
 
-      Low  : Node_Id;
-      High : Node_Id;
+      Low        : Node_Id;
+      High       : Node_Id;
 
       Nb_Choices : Nat := 0;
       Table      : Case_Table_Type (1 .. Number_Of_Choices (N));
@@ -1144,7 +1205,12 @@ package body Exp_Aggr is
             while Present (Choice) loop
                if Nkind (Choice) = N_Others_Choice then
                   Set_Loop_Actions (Assoc, New_List);
-                  Others_Expr := Expression (Assoc);
+
+                  if Box_Present (Assoc) then
+                     Others_Mbox_Present := True;
+                  else
+                     Others_Expr := Expression (Assoc);
+                  end if;
                   exit;
                end if;
 
@@ -1155,9 +1221,15 @@ package body Exp_Aggr is
                end if;
 
                Nb_Choices := Nb_Choices + 1;
-               Table (Nb_Choices) := (Choice_Lo   => Low,
-                                      Choice_Hi   => High,
-                                      Choice_Node => Expression (Assoc));
+               if Box_Present (Assoc) then
+                  Table (Nb_Choices) := (Choice_Lo   => Low,
+                                         Choice_Hi   => High,
+                                         Choice_Node => Empty);
+               else
+                  Table (Nb_Choices) := (Choice_Lo   => Low,
+                                         Choice_Hi   => High,
+                                         Choice_Node => Expression (Assoc));
+               end if;
                Next (Choice);
             end loop;
 
@@ -1185,7 +1257,7 @@ package body Exp_Aggr is
          --  We don't need to generate loops over empty gaps, but if there is
          --  a single empty range we must analyze the expression for semantics
 
-         if Present (Others_Expr) then
+         if Present (Others_Expr) or else Others_Mbox_Present then
             declare
                First : Boolean := True;
 
@@ -1254,12 +1326,21 @@ package body Exp_Aggr is
 
          if Present (Component_Associations (N)) then
             Assoc := Last (Component_Associations (N));
-            Expr  := Expression (Assoc);
 
-            Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
-                                    Aggr_High,
-                                    Expr),
-                         To => New_Code);
+            --  Ada0Y (AI-287)
+            if Box_Present (Assoc) then
+               Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
+                                       Aggr_High,
+                                       Empty),
+                            To => New_Code);
+            else
+               Expr  := Expression (Assoc);
+
+               Append_List (Gen_While (Add (Nb_Elements, To => Aggr_L),
+                                       Aggr_High,
+                                       Expr), --  AI-287
+                            To => New_Code);
+            end if;
          end if;
       end if;
 
@@ -1544,11 +1625,19 @@ package body Exp_Aggr is
          --  types and components
 
          if (Nkind (Target) = N_Identifier
+             and then Present (Etype (Target))
              and then Is_Limited_Type (Etype (Target)))
            or else (Nkind (Target) = N_Selected_Component
+                    and then Present (Etype (Selector_Name (Target)))
                     and then Is_Limited_Type (Etype (Selector_Name (Target))))
            or else (Nkind (Target) = N_Unchecked_Type_Conversion
+                    and then Present (Etype (Target))
                     and then Is_Limited_Type (Etype (Target)))
+           or else (Nkind (Target) = N_Unchecked_Expression
+                    and then Nkind (Expression (Target)) = N_Indexed_Component
+                    and then Present (Etype (Prefix (Expression (Target))))
+                    and then Is_Limited_Type
+                               (Etype (Prefix (Expression (Target)))))
          then
 
             if Init_Pr then
@@ -1666,11 +1755,22 @@ package body Exp_Aggr is
                Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
                Set_Assignment_OK (Ref);
 
-               Append_List_To (Start_L,
-                 Build_Initialization_Call (Loc,
-                   Id_Ref => Ref,
-                   Typ    => Init_Typ,
-                   In_Init_Proc => Within_Init_Proc));
+               if Has_Default_Init_Comps (N)
+                 or else Has_Task (Base_Type (Init_Typ))
+               then
+                  Append_List_To (Start_L,
+                    Build_Initialization_Call (Loc,
+                      Id_Ref       => Ref,
+                      Typ          => Init_Typ,
+                      In_Init_Proc => Within_Init_Proc,
+                      With_Default_Init => True));
+               else
+                  Append_List_To (Start_L,
+                    Build_Initialization_Call (Loc,
+                      Id_Ref       => Ref,
+                      Typ          => Init_Typ,
+                      In_Init_Proc => Within_Init_Proc));
+               end if;
 
                if Is_Constrained (Entity (A))
                  and then Has_Discriminants (Entity (A))
@@ -1812,18 +1912,48 @@ package body Exp_Aggr is
       while Present (Comp) loop
          Selector  := Entity (First (Choices (Comp)));
 
-         --  Default initialization of a limited component
+         --  Ada0Y (AI-287): Default initialization of a limited component
 
          if Box_Present (Comp)
             and then Is_Limited_Type (Etype (Selector))
          then
+
+            --  Ada0Y (AI-287): If the component type has tasks then generate
+            --  the activation chain and master entities (except in case of an
+            --  allocator because in that case these entities are generated
+            --  by Build_Task_Allocate_Block_With_Init_Stmts)
+
+            declare
+               Ctype            : Entity_Id := Etype (Selector);
+               Inside_Allocator : Boolean   := False;
+               P                : Node_Id   := Parent (N);
+
+            begin
+               if Is_Task_Type (Ctype) or else Has_Task (Ctype) then
+                  while Present (P) loop
+                     if Nkind (P) = N_Allocator then
+                        Inside_Allocator := True;
+                        exit;
+                     end if;
+
+                     P := Parent (P);
+                  end loop;
+
+                  if not Inside_Init_Proc and not Inside_Allocator then
+                     Build_Activation_Chain_Entity (N);
+                     Build_Master_Entity (Etype (N));
+                  end if;
+               end if;
+            end;
+
             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)));
+                                                                   Loc)),
+                Typ    => Etype (Selector),
+                With_Default_Init => True));
 
             goto Next_Comp;
          end if;
@@ -2200,10 +2330,26 @@ package body Exp_Aggr is
       Access_Type : constant Entity_Id := Etype (Temp);
 
    begin
-      Insert_Actions_After (Decl,
-        Late_Expansion (Aggr, Typ, Occ,
-          Find_Final_List (Access_Type),
-          Associated_Final_Chain (Base_Type (Access_Type))));
+      if Has_Default_Init_Comps (Aggr) then
+         declare
+            L          : constant List_Id := New_List;
+            Init_Stmts : List_Id;
+
+         begin
+            Init_Stmts := Late_Expansion (Aggr, Typ, Occ,
+                            Find_Final_List (Access_Type),
+                            Associated_Final_Chain (Base_Type (Access_Type)));
+
+            Build_Task_Allocate_Block_With_Init_Stmts (L, Aggr, Init_Stmts);
+            Insert_Actions_After (Decl, L);
+         end;
+
+      else
+         Insert_Actions_After (Decl,
+           Late_Expansion (Aggr, Typ, Occ,
+             Find_Final_List (Access_Type),
+             Associated_Final_Chain (Base_Type (Access_Type))));
+      end if;
    end Convert_Aggr_In_Allocator;
 
    --------------------------------
@@ -2706,6 +2852,14 @@ package body Exp_Aggr is
    --  Start of processing for Convert_To_Positional
 
    begin
+      --  Ada0Y (AI-287): Do not convert in case of default initialized
+      --  components because in this case will need to call the corresponding
+      --  IP procedure.
+
+      if Has_Default_Init_Comps (N) then
+         return;
+      end if;
+
       if Is_Flat (N, Number_Dimensions (Typ)) then
          return;
       end if;
@@ -3827,14 +3981,19 @@ package body Exp_Aggr is
            (N, Sec_Stack => Has_Controlled_Component (Typ));
       end if;
 
-      Maybe_In_Place_OK :=
-        Comes_From_Source (N)
-          and then Nkind (Parent (N)) = N_Assignment_Statement
-          and then not Is_Bit_Packed_Array (Typ)
-          and then not Has_Controlled_Component (Typ)
-          and then In_Place_Assign_OK;
+      if Has_Default_Init_Comps (N) then
+         Maybe_In_Place_OK := False;
+      else
+         Maybe_In_Place_OK :=
+           Comes_From_Source (N)
+             and then Nkind (Parent (N)) = N_Assignment_Statement
+             and then not Is_Bit_Packed_Array (Typ)
+             and then not Has_Controlled_Component (Typ)
+             and then In_Place_Assign_OK;
+      end if;
 
-      if Comes_From_Source (Parent (N))
+      if not Has_Default_Init_Comps (N)
+         and then Comes_From_Source (Parent (N))
          and then Nkind (Parent (N)) = N_Object_Declaration
          and then not Must_Slide (N, Typ)
          and then N = Expression (Parent (N))
@@ -3938,6 +4097,15 @@ package body Exp_Aggr is
             Target := New_Reference_To (Tmp, Loc);
 
          else
+
+            if Has_Default_Init_Comps (N) then
+
+               --  Ada0Y (AI-287): This case has not been analyzed???
+
+               pragma Assert (False);
+               null;
+            end if;
+
             --  Name in assignment is explicit dereference.
 
             Target := New_Copy (Tmp);
@@ -3945,6 +4113,7 @@ package body Exp_Aggr is
 
          Aggr_Code :=
            Build_Array_Aggr_Code (N,
+             Ctype       => Ctyp,
              Index       => First_Index (Typ),
              Into        => Target,
              Scalar_Comp => Is_Scalar_Type (Ctyp));
@@ -4478,14 +4647,17 @@ package body Exp_Aggr is
    function Has_Default_Init_Comps (N : Node_Id) return Boolean is
       Comps : constant List_Id := Component_Associations (N);
       C     : Node_Id;
-
+      Expr  : Node_Id;
    begin
       pragma Assert (Nkind (N) = N_Aggregate
-                     or else Nkind (N) = N_Extension_Aggregate);
+         or else Nkind (N) = N_Extension_Aggregate);
+
       if No (Comps) then
          return False;
       end if;
 
+      --  Check if any direct component has default initialized components
+
       C := First (Comps);
       while Present (C) loop
          if Box_Present (C) then
@@ -4494,6 +4666,24 @@ package body Exp_Aggr is
 
          Next (C);
       end loop;
+
+      --  Recursive call in case of aggregate expression
+
+      C := First (Comps);
+      while Present (C) loop
+         Expr := Expression (C);
+
+         if Present (Expr)
+           and then (Nkind (Expr) = N_Aggregate
+                     or else Nkind (Expr) = N_Extension_Aggregate)
+           and then Has_Default_Init_Comps (Expr)
+         then
+            return True;
+         end if;
+
+         Next (C);
+      end loop;
+
       return False;
    end Has_Default_Init_Comps;
 
@@ -4527,20 +4717,23 @@ package body Exp_Aggr is
       Typ    : Entity_Id;
       Target : Node_Id;
       Flist  : Node_Id   := Empty;
-      Obj    : Entity_Id := Empty) return List_Id
-   is
+      Obj    : Entity_Id := Empty) return List_Id is
    begin
       if Is_Record_Type (Etype (N)) then
          return Build_Record_Aggr_Code (N, Typ, Target, Flist, Obj);
-      else
+      elsif Is_Array_Type (Etype (N)) then
          return
            Build_Array_Aggr_Code
-             (N,
-              First_Index (Typ),
-              Target,
-              Is_Scalar_Type (Component_Type (Typ)),
-              No_List,
-              Flist);
+             (N           => N,
+              Ctype       => Component_Type (Etype (N)),
+              Index       => First_Index (Typ),
+              Into        => Target,
+              Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
+              Indices     => No_List,
+              Flist       => Flist);
+      else
+         pragma Assert (False);
+         return New_List;
       end if;
    end Late_Expansion;
 
Index: exp_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch3.adb,v
retrieving revision 1.10
diff -u -p -r1.10 exp_ch3.adb
--- exp_ch3.adb	27 Oct 2003 14:27:17 -0000	1.10
+++ exp_ch3.adb	8 Dec 2003 10:31:50 -0000
@@ -56,6 +56,7 @@ with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
+with Stringt;  use Stringt;
 with Snames;   use Snames;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
@@ -1032,13 +1033,14 @@ package body Exp_Ch3 is
    --  end;
 
    function Build_Initialization_Call
-     (Loc          : Source_Ptr;
-      Id_Ref       : Node_Id;
-      Typ          : Entity_Id;
-      In_Init_Proc : Boolean := False;
-      Enclos_Type  : Entity_Id := Empty;
-      Discr_Map    : Elist_Id := New_Elmt_List)
-      return         List_Id
+     (Loc               : Source_Ptr;
+      Id_Ref            : Node_Id;
+      Typ               : Entity_Id;
+      In_Init_Proc      : Boolean := False;
+      Enclos_Type       : Entity_Id := Empty;
+      Discr_Map         : Elist_Id := New_Elmt_List;
+      With_Default_Init : Boolean := False)
+      return              List_Id
    is
       First_Arg      : Node_Id;
       Args           : List_Id;
@@ -1076,7 +1078,6 @@ package body Exp_Ch3 is
       --  honest. Actually it isn't quite type honest, because there can be
       --  conflicts of views in the private type case. That is why we set
       --  Conversion_OK in the conversion node.
-
       if (Is_Record_Type (Typ)
            or else Is_Array_Type (Typ)
            or else Is_Private_Type (Typ))
@@ -1110,12 +1111,28 @@ package body Exp_Ch3 is
 
          Append_To (Args, Make_Identifier (Loc, Name_uChain));
 
-         Decls := Build_Task_Image_Decls (Loc, Id_Ref, Enclos_Type);
-         Decl  := Last (Decls);
+         --  Ada0Y (AI-287): In case of default initialized components
+         --  with tasks, we generate a null string actual parameter.
+         --  This is just a workaround that must be improved later???
 
-         Append_To (Args,
-           New_Occurrence_Of (Defining_Identifier (Decl), Loc));
-         Append_List (Decls, Res);
+         if With_Default_Init then
+            declare
+               S           : String_Id;
+               Null_String : Node_Id;
+            begin
+               Start_String;
+               S := End_String;
+               Null_String := Make_String_Literal (Loc, Strval => S);
+               Append_To (Args, Null_String);
+            end;
+         else
+            Decls := Build_Task_Image_Decls (Loc, Id_Ref, Enclos_Type);
+            Decl  := Last (Decls);
+
+            Append_To (Args,
+              New_Occurrence_Of (Defining_Identifier (Decl), Loc));
+            Append_List (Decls, Res);
+         end if;
 
       else
          Decls := No_List;
@@ -1202,7 +1219,22 @@ package body Exp_Ch3 is
                end if;
             end if;
 
-            Append_To (Args, Arg);
+            --  Ada0Y (AI-287) In case of default initialized components, we
+            --  need to generate the corresponding selected component node
+            --  to access the discriminant value. In other cases this is not
+            --  required because we are inside the init proc and we use the
+            --  corresponding formal.
+
+            if With_Default_Init
+              and then Nkind (Id_Ref) = N_Selected_Component
+            then
+               Append_To (Args,
+                 Make_Selected_Component (Loc,
+                   Prefix => New_Copy_Tree (Prefix (Id_Ref)),
+                   Selector_Name => Arg));
+            else
+               Append_To (Args, Arg);
+            end if;
 
             Next_Discriminant (Discr);
          end loop;
Index: exp_ch3.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch3.ads,v
retrieving revision 1.6
diff -u -p -r1.6 exp_ch3.ads
--- exp_ch3.ads	21 Oct 2003 13:41:59 -0000	1.6
+++ exp_ch3.ads	8 Dec 2003 10:31:50 -0000
@@ -52,13 +52,14 @@ package Exp_Ch3 is
    --  and the discriminant checking functions are inserted after this node.
 
    function Build_Initialization_Call
-     (Loc          : Source_Ptr;
-      Id_Ref       : Node_Id;
-      Typ          : Entity_Id;
-      In_Init_Proc : Boolean := False;
-      Enclos_Type  : Entity_Id := Empty;
-      Discr_Map    : Elist_Id := New_Elmt_List)
-      return         List_Id;
+     (Loc               : Source_Ptr;
+      Id_Ref            : Node_Id;
+      Typ               : Entity_Id;
+      In_Init_Proc      : Boolean := False;
+      Enclos_Type       : Entity_Id := Empty;
+      Discr_Map         : Elist_Id := New_Elmt_List;
+      With_Default_Init : Boolean := False)
+      return              List_Id;
    --  Builds a call to the initialization procedure of the Id entity. Id_Ref
    --  is either a new reference to Id (for record fields), or an indexed
    --  component (for array elements). Loc is the source location for the
@@ -76,6 +77,10 @@ package Exp_Ch3 is
    --  entry families bounded by discriminants, protected type discriminants
    --  can appear within expressions in array bounds (not as stand-alone
    --  identifiers) and a general replacement is necessary.
+   --
+   --  Ada0Y (AI-287): With_Default_Init is used to indicate that the initia-
+   --  lization call corresponds to a default initialized component of an
+   --  aggregate.
 
    procedure Freeze_Type (N : Node_Id);
    --  This procedure executes the freezing actions associated with the given
Index: exp_ch9.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch9.adb,v
retrieving revision 1.8
diff -u -p -r1.8 exp_ch9.adb
--- exp_ch9.adb	21 Oct 2003 13:41:59 -0000	1.8
+++ exp_ch9.adb	8 Dec 2003 10:31:51 -0000
@@ -69,8 +69,7 @@ package body Exp_Ch9 is
      (Sloc  : Source_Ptr;
       Ent   : Entity_Id;
       Index : Node_Id;
-      Tsk   : Entity_Id)
-      return  Node_Id;
+      Tsk   : Entity_Id) return Node_Id;
    --  Compute the index position for an entry call. Tsk is the target
    --  task. If the bounds of some entry family depend on discriminants,
    --  the expression computed by this function uses the discriminants
@@ -79,8 +78,7 @@ package body Exp_Ch9 is
    function Index_Constant_Declaration
      (N        : Node_Id;
       Index_Id : Entity_Id;
-      Prot     : Entity_Id)
-      return     List_Id;
+      Prot     : Entity_Id) return List_Id;
    --  For an entry family and its barrier function, we define a local entity
    --  that maps the index in the call into the entry index into the object:
    --
@@ -105,23 +103,20 @@ package body Exp_Ch9 is
    function Build_Barrier_Function
      (N    : Node_Id;
       Ent  : Entity_Id;
-      Pid  : Node_Id)
-      return Node_Id;
+      Pid  : Node_Id) return Node_Id;
    --  Build the function body returning the value of the barrier expression
    --  for the specified entry body.
 
    function Build_Barrier_Function_Specification
      (Def_Id : Entity_Id;
-      Loc    : Source_Ptr)
-      return   Node_Id;
+      Loc    : Source_Ptr) return Node_Id;
    --  Build a specification for a function implementing
    --  the protected entry barrier of the specified entry body.
 
    function Build_Corresponding_Record
      (N    : Node_Id;
       Ctyp : Node_Id;
-      Loc  : Source_Ptr)
-      return Node_Id;
+      Loc  : Source_Ptr) return Node_Id;
    --  Common to tasks and protected types. Copy discriminant specifications,
    --  build record declaration. N is the type declaration, Ctyp is the
    --  concurrent entity (task type or protected type).
@@ -129,40 +124,33 @@ package body Exp_Ch9 is
    function Build_Entry_Count_Expression
      (Concurrent_Type : Node_Id;
       Component_List  : List_Id;
-      Loc             : Source_Ptr)
-      return            Node_Id;
+      Loc             : Source_Ptr) return Node_Id;
    --  Compute number of entries for concurrent object. This is a count of
    --  simple entries, followed by an expression that computes the length
    --  of the range of each entry family. A single array with that size is
    --  allocated for each concurrent object of the type.
 
-   function Build_Find_Body_Index
-     (Typ  : Entity_Id)
-      return Node_Id;
+   function Build_Find_Body_Index (Typ : Entity_Id) return Node_Id;
    --  Build the function that translates the entry index in the call
    --  (which depends on the size of entry families) into an index into the
    --  Entry_Bodies_Array, to determine the body and barrier function used
    --  in a protected entry call. A pointer to this function appears in every
    --  protected object.
 
-   function Build_Find_Body_Index_Spec
-     (Typ  : Entity_Id)
-      return Node_Id;
-   --  Build subprogram declaration for previous one.
+   function Build_Find_Body_Index_Spec (Typ : Entity_Id) return Node_Id;
+   --  Build subprogram declaration for previous one
 
    function Build_Protected_Entry
-     (N         : Node_Id;
-      Ent       : Entity_Id;
-      Pid       : Node_Id)
-      return Node_Id;
+     (N   : Node_Id;
+      Ent : Entity_Id;
+      Pid : Node_Id) return Node_Id;
    --  Build the procedure implementing the statement sequence of
    --  the specified entry body.
 
    function Build_Protected_Entry_Specification
      (Def_Id : Entity_Id;
       Ent_Id : Entity_Id;
-      Loc    : Source_Ptr)
-      return Node_Id;
+      Loc    : Source_Ptr) return Node_Id;
    --  Build a specification for a procedure implementing
    --  the statement sequence of the specified entry body.
    --  Add attributes associating it with the entry defining identifier
@@ -171,8 +159,7 @@ package body Exp_Ch9 is
    function Build_Protected_Subprogram_Body
      (N         : Node_Id;
       Pid       : Node_Id;
-      N_Op_Spec : Node_Id)
-      return      Node_Id;
+      N_Op_Spec : Node_Id) return Node_Id;
    --  This function is used to construct the protected version of a protected
    --  subprogram. Its statement sequence first defers abortion, then locks
    --  the associated protected object, and then enters a block that contains
@@ -185,8 +172,7 @@ package body Exp_Ch9 is
      (N           : Node_Id;
       Obj_Type    : Entity_Id;
       Unprotected : Boolean := False;
-      Ident       : Entity_Id)
-      return        List_Id;
+      Ident       : Entity_Id) return List_Id;
    --  Utility shared by Build_Protected_Sub_Spec and Expand_Access_Protected_
    --  Subprogram_Type. Builds signature of protected subprogram, adding the
    --  formal that corresponds to the object itself. For an access to protected
@@ -197,8 +183,7 @@ package body Exp_Ch9 is
 
    function Build_Selected_Name
      (Prefix, Selector : Name_Id;
-      Append_Char      : Character := ' ')
-      return             Name_Id;
+      Append_Char      : Character := ' ') return Name_Id;
    --  Build a name in the form of Prefix__Selector, with an optional
    --  character appended. This is used for internal subprograms generated
    --  for operations of protected types, including barrier functions. In
@@ -227,9 +212,8 @@ package body Exp_Ch9 is
    --  value type that is associated with the task type.
 
    function Build_Unprotected_Subprogram_Body
-     (N    : Node_Id;
-      Pid  : Node_Id)
-      return Node_Id;
+     (N   : Node_Id;
+      Pid : Node_Id) return Node_Id;
    --  This routine constructs the unprotected version of a protected
    --  subprogram body, which is contains all of the code in the
    --  original, unexpanded body. This is the version of the protected
@@ -248,8 +232,7 @@ package body Exp_Ch9 is
      (Loc  : Source_Ptr;
       Hi   : Node_Id;
       Lo   : Node_Id;
-      Ttyp : Entity_Id)
-      return Node_Id;
+      Ttyp : Entity_Id) return Node_Id;
    --  Compute (Hi - Lo) for two entry family indices. Hi is the index in
    --  an accept statement, or the upper bound in the discrete subtype of
    --  an entry declaration. Lo is the corresponding lower bound. Ttyp is
@@ -259,8 +242,7 @@ package body Exp_Ch9 is
      (Loc  : Source_Ptr;
       Hi   : Node_Id;
       Lo   : Node_Id;
-      Ttyp : Entity_Id)
-      return Node_Id;
+      Ttyp : Entity_Id) return Node_Id;
    --  Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in
    --  a family, and handle properly the superflat case. This is equivalent
    --  to the use of 'Length on the index type, but must use Family_Offset
@@ -275,9 +257,8 @@ package body Exp_Ch9 is
    --  the entry name, and the entry family index.
 
    function Find_Task_Or_Protected_Pragma
-     (T    : Node_Id;
-      P    : Name_Id)
-      return Node_Id;
+     (T : Node_Id;
+      P : Name_Id) return Node_Id;
    --  Searches the task or protected definition T for the first occurrence
    --  of the pragma whose name is given by P. The caller has ensured that
    --  the pragma is present in the task definition. A special case is that
@@ -302,8 +283,7 @@ package body Exp_Ch9 is
      (Sloc  : Source_Ptr;
       Ent   : Entity_Id;
       Index : Node_Id;
-      Tsk   : Entity_Id)
-      return  Node_Id
+      Tsk   : Entity_Id) return Node_Id
    is
       Ttyp : constant Entity_Id := Etype (Tsk);
       Expr : Node_Id;
@@ -746,8 +726,7 @@ package body Exp_Ch9 is
    function Build_Barrier_Function
      (N    : Node_Id;
       Ent  : Entity_Id;
-      Pid  : Node_Id)
-      return Node_Id
+      Pid  : Node_Id) return Node_Id
    is
       Loc         : constant Source_Ptr := Sloc (N);
       Ent_Formals : constant Node_Id    := Entry_Body_Formal_Part (N);
@@ -816,8 +795,7 @@ package body Exp_Ch9 is
 
    function Build_Barrier_Function_Specification
      (Def_Id : Entity_Id;
-      Loc    : Source_Ptr)
-      return   Node_Id
+      Loc    : Source_Ptr) return Node_Id
    is
    begin
       return Make_Function_Specification (Loc,
@@ -841,9 +819,8 @@ package body Exp_Ch9 is
    --------------------------
 
    function Build_Call_With_Task
-     (N    : Node_Id;
-      E    : Entity_Id)
-      return Node_Id
+     (N : Node_Id;
+      E : Entity_Id) return Node_Id
    is
       Loc : constant Source_Ptr := Sloc (N);
 
@@ -861,8 +838,7 @@ package body Exp_Ch9 is
    function Build_Corresponding_Record
     (N    : Node_Id;
      Ctyp : Entity_Id;
-     Loc  : Source_Ptr)
-     return Node_Id
+     Loc  : Source_Ptr) return Node_Id
    is
       Rec_Ent  : constant Entity_Id :=
                    Make_Defining_Identifier
@@ -941,8 +917,7 @@ package body Exp_Ch9 is
    function Build_Entry_Count_Expression
      (Concurrent_Type : Node_Id;
       Component_List  : List_Id;
-      Loc             : Source_Ptr)
-      return            Node_Id
+      Loc             : Source_Ptr) return Node_Id
    is
       Eindx  : Nat;
       Ent    : Entity_Id;
@@ -999,10 +974,7 @@ package body Exp_Ch9 is
    -- Build_Find_Body_Index --
    ---------------------------
 
-   function Build_Find_Body_Index
-      (Typ : Entity_Id)
-      return Node_Id
-   is
+   function Build_Find_Body_Index (Typ : Entity_Id) return Node_Id is
       Loc   : constant Source_Ptr := Sloc (Typ);
       Ent   : Entity_Id;
       E_Typ : Entity_Id;
@@ -1192,10 +1164,7 @@ package body Exp_Ch9 is
    -- Build_Find_Body_Index_Spec --
    --------------------------------
 
-   function Build_Find_Body_Index_Spec
-      (Typ : Entity_Id)
-      return Node_Id
-   is
+   function Build_Find_Body_Index_Spec (Typ : Entity_Id) return Node_Id is
       Loc   : constant Source_Ptr := Sloc (Typ);
       Id    : constant Entity_Id :=
                Make_Defining_Identifier (Loc,
@@ -1285,10 +1254,9 @@ package body Exp_Ch9 is
    ---------------------------
 
    function Build_Protected_Entry
-     (N    : Node_Id;
-      Ent  : Entity_Id;
-      Pid  : Node_Id)
-      return Node_Id
+     (N   : Node_Id;
+      Ent : Entity_Id;
+      Pid : Node_Id) return Node_Id
    is
       Loc      : constant Source_Ptr := Sloc (N);
       Op_Decls : constant List_Id    := New_List;
@@ -1401,8 +1369,7 @@ package body Exp_Ch9 is
    function Build_Protected_Entry_Specification
      (Def_Id : Entity_Id;
       Ent_Id : Entity_Id;
-      Loc    : Source_Ptr)
-      return   Node_Id
+      Loc    : Source_Ptr) return Node_Id
    is
       P : Entity_Id;
 
@@ -1440,8 +1407,7 @@ package body Exp_Ch9 is
      (N           : Node_Id;
       Obj_Type    : Entity_Id;
       Unprotected : Boolean := False;
-      Ident       : Entity_Id)
-      return        List_Id
+      Ident       : Entity_Id) return List_Id
    is
       Loc         : constant Source_Ptr := Sloc (N);
       Formal      : Entity_Id;
@@ -1494,8 +1460,7 @@ package body Exp_Ch9 is
    function Build_Protected_Sub_Specification
      (N           : Node_Id;
       Prottyp     : Entity_Id;
-      Unprotected : Boolean := False)
-      return        Node_Id
+      Unprotected : Boolean := False) return Node_Id
    is
       Loc         : constant Source_Ptr := Sloc (N);
       Decl        : Node_Id;
@@ -1556,8 +1521,7 @@ package body Exp_Ch9 is
    function Build_Protected_Subprogram_Body
      (N         : Node_Id;
       Pid       : Node_Id;
-      N_Op_Spec : Node_Id)
-      return      Node_Id
+      N_Op_Spec : Node_Id) return Node_Id
    is
       Loc          : constant Source_Ptr := Sloc (N);
       Op_Spec      : Node_Id;
@@ -1573,9 +1537,8 @@ package body Exp_Ch9 is
       Service_Name : Node_Id;
       Service_Stmt : Node_Id;
       R            : Node_Id;
-      Return_Stmt  : Node_Id := Empty;
-      Pre_Stmts    : List_Id := No_List;
-      --   Initializations to avoid spurious warnings from GCC3.
+      Return_Stmt  : Node_Id := Empty;    -- init to avoid gcc 3 warning
+      Pre_Stmts    : List_Id := No_List;  -- init to avoid gcc 3 warning
       Stmts        : List_Id;
       Object_Parm  : Node_Id;
       Exc_Safe     : Boolean;
@@ -1906,7 +1869,6 @@ package body Exp_Ch9 is
       then
          Add_Shared_Var_Lock_Procs (N);
       end if;
-
    end Build_Protected_Subprogram_Call;
 
    -------------------------
@@ -1915,8 +1877,7 @@ package body Exp_Ch9 is
 
    function Build_Selected_Name
      (Prefix, Selector : Name_Id;
-      Append_Char      : Character := ' ')
-      return             Name_Id
+      Append_Char      : Character := ' ') return Name_Id
    is
       Select_Buffer : String (1 .. Hostparm.Max_Name_Length);
       Select_Len    : Natural;
@@ -2336,7 +2297,6 @@ package body Exp_Ch9 is
 
          Analyze (N);
       end;
-
    end Build_Simple_Entry_Call;
 
    --------------------------------
@@ -2352,7 +2312,7 @@ package body Exp_Ch9 is
 
    begin
       --  Get the activation chain entity. Except in the case of a package
-      --  body, this is in the node that was passed. For a package body, we
+      --  body, this is in the node that w as passed. For a package body, we
       --  have to find the corresponding package declaration node.
 
       if Nkind (N) = N_Package_Body then
@@ -2424,7 +2384,6 @@ package body Exp_Ch9 is
          Analyze (Call);
          Check_Task_Activation (N);
       end if;
-
    end Build_Task_Activation_Call;
 
    -------------------------------
@@ -2492,9 +2451,63 @@ package body Exp_Ch9 is
       Append_To (Actions, Block);
 
       Set_Activation_Chain_Entity (Block, Chain);
-
    end Build_Task_Allocate_Block;
 
+   -----------------------------------------------
+   -- Build_Task_Allocate_Block_With_Init_Stmts --
+   -----------------------------------------------
+
+   procedure Build_Task_Allocate_Block_With_Init_Stmts
+     (Actions    : List_Id;
+      N          : Node_Id;
+      Init_Stmts : List_Id)
+   is
+      Loc    : constant Source_Ptr := Sloc (N);
+      Chain  : constant Entity_Id  :=
+                 Make_Defining_Identifier (Loc, Name_uChain);
+      Blkent : Entity_Id;
+      Block  : Node_Id;
+
+   begin
+      Blkent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+
+      Append_To (Init_Stmts,
+        Make_Procedure_Call_Statement (Loc,
+          Name => New_Reference_To (RTE (RE_Activate_Tasks), Loc),
+          Parameter_Associations => New_List (
+            Make_Attribute_Reference (Loc,
+              Prefix => New_Reference_To (Chain, Loc),
+              Attribute_Name => Name_Unchecked_Access))));
+
+      Block :=
+        Make_Block_Statement (Loc,
+          Identifier => New_Reference_To (Blkent, Loc),
+          Declarations => New_List (
+
+            --  _Chain  : Activation_Chain;
+
+            Make_Object_Declaration (Loc,
+              Defining_Identifier => Chain,
+              Aliased_Present => True,
+              Object_Definition   =>
+                New_Reference_To (RTE (RE_Activation_Chain), Loc))),
+
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (Loc, Init_Stmts),
+
+          Has_Created_Identifier => True,
+          Is_Task_Allocation_Block => True);
+
+      Append_To (Actions,
+        Make_Implicit_Label_Declaration (Loc,
+          Defining_Identifier => Blkent,
+          Label_Construct     => Block));
+
+      Append_To (Actions, Block);
+
+      Set_Activation_Chain_Entity (Block, Chain);
+   end Build_Task_Allocate_Block_With_Init_Stmts;
+
    -----------------------------------
    -- Build_Task_Proc_Specification --
    -----------------------------------
@@ -2531,7 +2544,6 @@ package body Exp_Ch9 is
                     Subtype_Mark =>
                       New_Reference_To
                         (Corresponding_Record_Type (T), Loc)))));
-
    end Build_Task_Proc_Specification;
 
    ---------------------------------------
@@ -2539,9 +2551,8 @@ package body Exp_Ch9 is
    ---------------------------------------
 
    function Build_Unprotected_Subprogram_Body
-     (N    : Node_Id;
-      Pid  : Node_Id)
-      return Node_Id
+     (N   : Node_Id;
+      Pid : Node_Id) return Node_Id
    is
       Loc       : constant Source_Ptr := Sloc (N);
       N_Op_Spec : Node_Id;
@@ -2563,7 +2574,6 @@ package body Exp_Ch9 is
           Declarations => Op_Decls,
           Handled_Statement_Sequence =>
             Handled_Statement_Sequence (N));
-
    end Build_Unprotected_Subprogram_Body;
 
    ----------------------------
@@ -2800,9 +2810,8 @@ package body Exp_Ch9 is
    ------------------------
 
    function Convert_Concurrent
-     (N    : Node_Id;
-      Typ  : Entity_Id)
-      return Node_Id
+     (N   : Node_Id;
+      Typ : Entity_Id) return Node_Id
    is
    begin
       if not Is_Concurrent_Type (Typ) then
@@ -2822,8 +2831,7 @@ package body Exp_Ch9 is
      (Sloc  : Source_Ptr;
       Ent   : Entity_Id;
       Index : Node_Id;
-      Ttyp  : Entity_Id)
-      return  Node_Id
+      Ttyp  : Entity_Id) return Node_Id
    is
       Expr : Node_Id;
       Num  : Node_Id;
@@ -4550,7 +4558,6 @@ package body Exp_Ch9 is
          Set_Privals (Dec, Next_Op, Loc);
          Set_Discriminals (Dec);
       end if;
-
    end Expand_N_Entry_Body;
 
    -----------------------------------
@@ -6049,7 +6056,6 @@ package body Exp_Ch9 is
            Make_Aggregate (Loc, Expressions => New_List (Null_Body, Expr)));
 
          Num_Accept := Num_Accept + 1;
-
       end Add_Accept;
 
       ----------------------------
@@ -7716,8 +7722,7 @@ package body Exp_Ch9 is
      (Loc  : Source_Ptr;
       Hi   : Node_Id;
       Lo   : Node_Id;
-      Ttyp : Entity_Id)
-      return Node_Id
+      Ttyp : Entity_Id) return Node_Id
    is
       function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
       --  If one of the bounds is a reference to a discriminant, replace
@@ -7790,8 +7795,7 @@ package body Exp_Ch9 is
      (Loc  : Source_Ptr;
       Hi   : Node_Id;
       Lo   : Node_Id;
-      Ttyp : Entity_Id)
-      return Node_Id
+      Ttyp : Entity_Id) return Node_Id
    is
       Ityp : Entity_Id;
 
@@ -7820,9 +7824,8 @@ package body Exp_Ch9 is
    -----------------------------------
 
    function Find_Task_Or_Protected_Pragma
-     (T    : Node_Id;
-      P    : Name_Id)
-      return Node_Id
+     (T : Node_Id;
+      P : Name_Id) return Node_Id
    is
       N : Node_Id;
 
@@ -7898,8 +7901,7 @@ package body Exp_Ch9 is
    function Index_Constant_Declaration
      (N        : Node_Id;
       Index_Id : Entity_Id;
-      Prot     : Entity_Id)
-      return     List_Id
+      Prot     : Entity_Id) return List_Id
    is
       Loc       : constant Source_Ptr := Sloc (N);
       Decls     : constant List_Id    := New_List;
@@ -8003,8 +8005,7 @@ package body Exp_Ch9 is
    --------------------------------
 
    function Make_Initialize_Protection
-     (Protect_Rec : Entity_Id)
-      return        List_Id
+     (Protect_Rec : Entity_Id) return List_Id
    is
       Loc         : constant Source_Ptr := Sloc (Protect_Rec);
       P_Arr       : Entity_Id;
Index: exp_ch9.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch9.ads,v
retrieving revision 1.5
diff -u -p -r1.5 exp_ch9.ads
--- exp_ch9.ads	24 Apr 2003 17:54:00 -0000	1.5
+++ exp_ch9.ads	8 Dec 2003 10:31:51 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -163,6 +163,15 @@ package Exp_Ch9 is
    --  for the initialization call, constructed by the caller, which uses
    --  the Master_Id of the access type as the _Master parameter, and _Chain
    --  (defined above) as the _Chain parameter.
+
+   procedure Build_Task_Allocate_Block_With_Init_Stmts
+     (Actions    : List_Id;
+      N          : Node_Id;
+      Init_Stmts : List_Id);
+   --  Ada0Y (AI-287): Similar to previous routine, but used to expand alloca-
+   --  ted aggregates with default initialized components. Init_Stmts contains
+   --  the list of statements required to initialize the allocated aggregate.
+   --  It replaces the call to Init (Args) done by Build_Task_Allocate_Block.
 
    function Concurrent_Ref (N : Node_Id) return Node_Id;
    --  Given the name of a concurrent object (task or protected object), or
Index: gnatbind.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatbind.adb,v
retrieving revision 1.7
diff -u -p -r1.7 gnatbind.adb
--- gnatbind.adb	21 Oct 2003 13:42:05 -0000	1.7
+++ gnatbind.adb	8 Dec 2003 10:31:51 -0000
@@ -471,7 +471,7 @@ begin
 
       --  Add System.Standard_Library to list to ensure that these files are
       --  included in the bind, even if not directly referenced from Ada code
-      --  This is suppressed if the configurable run-time requests it.
+      --  This is suppressed if the appropriate targparm switch is set.
 
       if not Suppress_Standard_Library_On_Target then
          Name_Buffer (1 .. 12) := "s-stalib.ali";
Index: lib.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib.ads,v
retrieving revision 1.8
diff -u -p -r1.8 lib.ads
--- lib.ads	24 Nov 2003 14:27:57 -0000	1.8
+++ lib.ads	8 Dec 2003 10:31:51 -0000
@@ -587,7 +587,7 @@ package Lib is
    --  function returns True if the given generic unit entity E is for a
    --  generic unit that should be separately compiled, and false otherwise.
    --
-   --  Now GNAT can compile any generic unit including predefifined ones, but
+   --  Now GNAT can compile any generic unit including predefined ones, but
    --  because of the backward compatibility (to keep the ability to use old
    --  compiler versions to build GNAT) compiling library generics is an
    --  option. That is, now GNAT compiles a library generic as an ordinary
Index: par-ch4.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch4.adb,v
retrieving revision 1.9
diff -u -p -r1.9 par-ch4.adb
--- par-ch4.adb	20 Nov 2003 09:54:00 -0000	1.9
+++ par-ch4.adb	8 Dec 2003 10:31:51 -0000
@@ -1167,6 +1167,20 @@ package body Ch4 is
             end if;
          end if;
 
+         --  Ada0Y (AI-287): The box notation is allowed only with named
+         --  notation because positional notation might be error prone. For
+         --  example, in "(X, <>, Y, <>)", there is no type associated with
+         --  the boxes, so you might not be leaving out the components you
+         --  thought you were leaving out.
+
+         if Extensions_Allowed and then Token = Tok_Box then
+            Error_Msg_SC ("(Ada 0Y) box notation only allowed with "
+                          & "named notation");
+            Scan; --  past BOX
+            Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
+            return Aggregate_Node;
+         end if;
+
          Expr_Node := P_Expression_Or_Range_Attribute;
 
          --  Extension aggregate case
@@ -1390,9 +1404,13 @@ package body Ch4 is
       TF_Arrow;
 
       if Token = Tok_Box then
+
+         --  Ada0Y (AI-287): The box notation is used to indicate the default
+         --  initialization of limited aggregate components
+
          if not Extensions_Allowed then
             Error_Msg_SP
-              ("Limited aggregates are an Ada0X extension");
+              ("(Ada 0Y) limited aggregates are an Ada0X extension");
 
             if OpenVMS then
                Error_Msg_SP
Index: prj.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj.adb,v
retrieving revision 1.13
diff -u -p -r1.13 prj.adb
--- prj.adb	20 Nov 2003 09:54:00 -0000	1.13
+++ prj.adb	8 Dec 2003 10:31:51 -0000
@@ -123,7 +123,8 @@ package body Prj is
       Seen                           => False,
       Flag1                          => False,
       Flag2                          => False,
-      Depth                          => 0);
+      Depth                          => 0,
+      Unkept_Comments                => False);
 
    -------------------
    -- Add_To_Buffer --
@@ -386,15 +387,6 @@ package body Prj is
         and then Left.Current_Body_Suffix = Right.Current_Body_Suffix
         and then Left.Separate_Suffix = Right.Separate_Suffix;
    end Same_Naming_Scheme;
-
-   ----------
-   -- Scan --
-   ----------
-
-   procedure Scan is
-   begin
-      Scanner.Scan;
-   end Scan;
 
    --------------------------
    -- Standard_Naming_Data --
Index: prj.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj.ads,v
retrieving revision 1.15
diff -u -p -r1.15 prj.ads
--- prj.ads	20 Nov 2003 09:54:00 -0000	1.15
+++ prj.ads	8 Dec 2003 10:31:51 -0000
@@ -554,6 +554,10 @@ package Prj is
       --  The maximum depth of a project in the project graph.
       --  Depth of main project is 0.
 
+      Unkept_Comments : Boolean := False;
+      --  True if there are comments in the project sources that cannot
+      --  be kept in the project tree.
+
    end record;
 
    function Empty_Project return Project_Data;
@@ -609,10 +613,6 @@ package Prj is
    --  imports B, directly or indirectly, Action will be called for A before
    --  it is called for B. With_State may be used by Action to choose a
    --  behavior or to report some global result.
-
-   procedure Scan;
-   pragma Inline (Scan);
-   --  Scan a token. Change all operator symbols to literal strings.
 
 private
 
Index: prj-dect.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-dect.adb,v
retrieving revision 1.8
diff -u -p -r1.8 prj-dect.adb
--- prj-dect.adb	21 Oct 2003 13:42:12 -0000	1.8
+++ prj-dect.adb	8 Dec 2003 10:31:51 -0000
@@ -125,6 +125,7 @@ package body Prj.Dect is
    begin
       Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
       Set_Location_Of (Attribute, To => Token_Ptr);
+      Set_Previous_Line_Node (Attribute);
 
       --  Scan past "for"
 
@@ -467,6 +468,9 @@ package body Prj.Dect is
       if Current_Attribute = Empty_Attribute then
          Attribute := Empty_Node;
       end if;
+
+      Set_End_Of_Line (Attribute);
+      Set_Previous_Line_Node (Attribute);
    end Parse_Attribute_Declaration;
 
    -----------------------------
@@ -535,6 +539,9 @@ package body Prj.Dect is
       Expect (Tok_Is, "IS");
 
       if Token = Tok_Is then
+         Set_End_Of_Line (Case_Construction);
+         Set_Previous_Line_Node (Case_Construction);
+         Set_Next_End_Node (Case_Construction);
 
          --  Scan past "is"
 
@@ -571,6 +578,8 @@ package body Prj.Dect is
             Scan;
 
             Expect (Tok_Arrow, "`=>`");
+            Set_End_Of_Line (Current_Item);
+            Set_Previous_Line_Node (Current_Item);
 
             --  Empty_Node in Field1 of a Case_Item indicates
             --  the "when others =>" branch.
@@ -596,6 +605,8 @@ package body Prj.Dect is
             Set_First_Choice_Of (Current_Item, To => First_Choice);
 
             Expect (Tok_Arrow, "`=>`");
+            Set_End_Of_Line (Current_Item);
+            Set_Previous_Line_Node (Current_Item);
 
             Parse_Declarative_Items
               (Declarations    => First_Declarative_Item,
@@ -613,6 +624,7 @@ package body Prj.Dect is
       End_Case_Construction;
 
       Expect (Tok_End, "`END CASE`");
+      Remove_Next_End_Node;
 
       if Token = Tok_End then
 
@@ -629,6 +641,7 @@ package body Prj.Dect is
       Scan;
 
       Expect (Tok_Semicolon, "`;`");
+      Set_Previous_End_Node (Case_Construction);
 
    end Parse_Case_Construction;
 
@@ -673,6 +686,9 @@ package body Prj.Dect is
                   Current_Project => Current_Project,
                   Current_Package => Current_Package);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_For =>
 
                Parse_Attribute_Declaration
@@ -681,6 +697,9 @@ package body Prj.Dect is
                   Current_Project => Current_Project,
                   Current_Package => Current_Package);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_Package =>
 
                --  Package declaration
@@ -693,6 +712,8 @@ package body Prj.Dect is
                  (Package_Declaration => Current_Declaration,
                   Current_Project     => Current_Project);
 
+               Set_Previous_End_Node (Current_Declaration);
+
             when Tok_Type =>
 
                --  Type String Declaration
@@ -706,6 +727,9 @@ package body Prj.Dect is
                  (String_Type     => Current_Declaration,
                   Current_Project => Current_Project);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_Case =>
 
                --  Case construction
@@ -716,6 +740,8 @@ package body Prj.Dect is
                   Current_Project   => Current_Project,
                   Current_Package   => Current_Package);
 
+               Set_Previous_End_Node (Current_Declaration);
+
             when others =>
                exit;
 
@@ -928,8 +954,13 @@ package body Prj.Dect is
          end if;
 
          Expect (Tok_Semicolon, "`;`");
+         Set_End_Of_Line (Package_Declaration);
+         Set_Previous_Line_Node (Package_Declaration);
 
       elsif Token = Tok_Is then
+         Set_End_Of_Line (Package_Declaration);
+         Set_Previous_Line_Node (Package_Declaration);
+         Set_Next_End_Node (Package_Declaration);
 
          Parse_Declarative_Items
            (Declarations    => First_Declarative_Item,
@@ -970,6 +1001,7 @@ package body Prj.Dect is
          end if;
 
          Expect (Tok_Semicolon, "`;`");
+         Remove_Next_End_Node;
 
       else
          Error_Msg ("expected IS or RENAMES", Token_Ptr);
Index: prj-part.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-part.adb,v
retrieving revision 1.9
diff -u -p -r1.9 prj-part.adb
--- prj-part.adb	10 Nov 2003 17:29:59 -0000	1.9
+++ prj-part.adb	8 Dec 2003 10:31:51 -0000
@@ -81,6 +81,7 @@ package body Prj.Part is
       Path         : Name_Id;
       Location     : Source_Ptr;
       Limited_With : Boolean;
+      Node         : Project_Node_Id;
       Next         : With_Id;
    end record;
    --  Information about an imported project, to be put in table Withs below
@@ -426,7 +427,8 @@ package body Prj.Part is
      (Project                : out Project_Node_Id;
       Project_File_Name      : String;
       Always_Errout_Finalize : Boolean;
-      Packages_To_Check      : String_List_Access := All_Packages)
+      Packages_To_Check      : String_List_Access := All_Packages;
+      Store_Comments         : Boolean := False)
    is
       Current_Directory : constant String := Get_Current_Dir;
 
@@ -451,6 +453,8 @@ package body Prj.Part is
 
       begin
          Prj.Err.Initialize;
+         Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
+         Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
 
          --  Parse the main project file
 
@@ -578,6 +582,8 @@ package body Prj.Part is
 
       Current_With : With_Record;
 
+      Current_With_Node : Project_Node_Id := Empty_Node;
+
    begin
       --  Assume no context clause
 
@@ -588,6 +594,7 @@ package body Prj.Part is
       --  or we have exhausted the with clauses.
 
       while Token = Tok_With or else Token = Tok_Limited loop
+         Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause);
          Limited_With := Token = Tok_Limited;
 
          if Limited_With then
@@ -612,6 +619,7 @@ package body Prj.Part is
               (Path         => Token_Name,
                Location     => Token_Ptr,
                Limited_With => Limited_With,
+               Node         => Current_With_Node,
                Next         => No_With);
 
             Withs.Increment_Last;
@@ -629,6 +637,8 @@ package body Prj.Part is
             Scan;
 
             if Token = Tok_Semicolon then
+               Set_End_Of_Line (Current_With_Node);
+               Set_Previous_Line_Node (Current_With_Node);
 
                --  End of (possibly multiple) with clause;
 
@@ -639,6 +649,9 @@ package body Prj.Part is
                Error_Msg ("expected comma or semi colon", Token_Ptr);
                exit Comma_Loop;
             end if;
+
+            Current_With_Node :=
+              Default_Project_Node (Of_Kind => N_With_Clause);
          end loop Comma_Loop;
       end loop With_Loop;
    end Pre_Parse_Context_Clause;
@@ -714,13 +727,11 @@ package body Prj.Part is
 
                   --  First with clause of the context clause
 
-                  Current_Project := Default_Project_Node
-                                           (Of_Kind => N_With_Clause);
+                  Current_Project := Current_With.Node;
                   Imported_Projects := Current_Project;
 
                else
-                  Next_Project := Default_Project_Node
-                                        (Of_Kind => N_With_Clause);
+                  Next_Project := Current_With.Node;
                   Set_Next_With_Clause_Of (Current_Project, Next_Project);
                   Current_Project := Next_Project;
                end if;
@@ -829,6 +840,8 @@ package body Prj.Part is
 
       use Tree_Private_Part;
 
+      Project_Comment_State : Tree.Comment_State;
+
    begin
       declare
          Normed : String := Normalize_Pathname (Path_Name);
@@ -868,6 +881,8 @@ package body Prj.Part is
          end if;
       end loop;
 
+      --  Put the new path name on the stack
+
       Project_Stack.Increment_Last;
       Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
 
@@ -933,6 +948,7 @@ package body Prj.Part is
 
       Save_Project_Scan_State (Project_Scan_State);
       Source_Index := Load_Project_File (Path_Name);
+      Tree.Save (Project_Comment_State);
 
       --  if we cannot find it, we stop
 
@@ -943,6 +959,7 @@ package body Prj.Part is
       end if;
 
       Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
+      Tree.Reset_State;
       Scan;
 
       if Name_From_Path = No_Name then
@@ -962,6 +979,10 @@ package body Prj.Part is
          Write_Eol;
       end if;
 
+      --  Is there any imported project?
+
+      Pre_Parse_Context_Clause (First_With);
+
       Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
       Project := Default_Project_Node (Of_Kind => N_Project);
       Project_Stack.Table (Project_Stack.Last).Id := Project;
@@ -969,10 +990,6 @@ package body Prj.Part is
       Set_Path_Name_Of (Project, Normed_Path_Name);
       Set_Location_Of (Project, Token_Ptr);
 
-      --  Is there any imported project?
-
-      Pre_Parse_Context_Clause (First_With);
-
       Expect (Tok_Project, "PROJECT");
 
       --  Mark location of PROJECT token if present
@@ -1276,6 +1293,9 @@ package body Prj.Part is
       end if;
 
       Expect (Tok_Is, "IS");
+      Set_End_Of_Line (Project);
+      Set_Previous_Line_Node (Project);
+      Set_Next_End_Node (Project);
 
       declare
          Project_Declaration : Project_Node_Id := Empty_Node;
@@ -1296,6 +1316,7 @@ package body Prj.Part is
       end;
 
       Expect (Tok_End, "END");
+      Remove_Next_End_Node;
 
       --  Skip "end" if present
 
@@ -1353,6 +1374,7 @@ package body Prj.Part is
       --  source.
 
       if Token = Tok_Semicolon then
+         Set_Previous_End_Node (Project);
          Scan;
 
          if Token /= Tok_EOF then
@@ -1368,6 +1390,15 @@ package body Prj.Part is
       --  And remove the project from the project stack
 
       Project_Stack.Decrement_Last;
+
+      --  Indicate if there are unkept comments
+
+      Tree.Set_Project_File_Includes_Unkept_Comments
+        (Node => Project, To => Tree.There_Are_Unkept_Comments);
+
+      --  And restore the comment state that was saved
+
+      Tree.Restore (Project_Comment_State);
    end Parse_Single_Project;
 
    -----------------------
Index: prj-part.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-part.ads,v
retrieving revision 1.5
diff -u -p -r1.5 prj-part.ads
--- prj-part.ads	21 Oct 2003 13:42:12 -0000	1.5
+++ prj-part.ads	8 Dec 2003 10:31:51 -0000
@@ -34,13 +34,15 @@ package Prj.Part is
      (Project                : out Project_Node_Id;
       Project_File_Name      : String;
       Always_Errout_Finalize : Boolean;
-      Packages_To_Check      : String_List_Access := All_Packages);
+      Packages_To_Check      : String_List_Access := All_Packages;
+      Store_Comments         : Boolean := False);
    --  Parse project file and all its imported project files and create a tree.
    --  Return the node for the project (or Empty_Node if parsing failed). If
    --  Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
    --  Otherwise, Errout.Finalize is only called if there are errors (but not
    --  if there are only warnings). Packages_To_Check indicates the packages
    --  where any unknown attribute produces an error. For other packages, an
-   --  unknown attribute produces a warning.
+   --  unknown attribute produces a warning. When Store_Comments is True,
+   --  comments are stored in the parse tree.
 
 end Prj.Part;
Index: prj-pp.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-pp.adb,v
retrieving revision 1.6
diff -u -p -r1.6 prj-pp.adb
--- prj-pp.adb	21 Oct 2003 13:42:12 -0000	1.6
+++ prj-pp.adb	8 Dec 2003 10:31:51 -0000
@@ -27,8 +27,8 @@
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 
 with Hostparm;
-with Namet;     use Namet;
-with Output;    use Output;
+with Namet;    use Namet;
+with Output;   use Output;
 with Snames;
 
 package body Prj.PP is
@@ -47,7 +47,6 @@ package body Prj.PP is
    procedure Indicate_Tested (Kind : Project_Node_Kind);
    --  Set the corresponding component of array Not_Tested to False.
    --  Only called by pragmas Debug.
-   --
 
    ---------------------
    -- Indicate_Tested --
@@ -98,9 +97,13 @@ package body Prj.PP is
       procedure Write_Line (S : String);
       --  Outputs S followed by a new line
 
-      procedure Write_String (S : String);
+      procedure Write_String (S : String; Truncated : Boolean := False);
       --  Outputs S using Write_Str, starting a new line if line would
-      --  become too long.
+      --  become too long, when Truncated = False.
+      --  When Truncated = True, only the part of the string that can fit on
+      --  the line is output.
+
+      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
 
       Write_Char : Write_Char_Ap := Output.Write_Char'Access;
       Write_Eol  : Write_Eol_Ap  := Output.Write_Eol'Access;
@@ -246,6 +249,21 @@ package body Prj.PP is
          end if;
       end Write_Empty_Line;
 
+      -------------------------------
+      -- Write_End_Of_Line_Comment --
+      -------------------------------
+
+      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
+         Value : Name_Id := End_Of_Line_Comment (Node);
+      begin
+         if Value /= No_Name then
+            Write_String (" --");
+            Write_String (Get_Name_String (Value), Truncated => True);
+         end if;
+
+         Write_Line ("");
+      end Write_End_Of_Line_Comment;
+
       ----------------
       -- Write_Line --
       ----------------
@@ -262,18 +280,24 @@ package body Prj.PP is
       -- Write_String --
       ------------------
 
-      procedure Write_String (S : String) is
+      procedure Write_String (S : String; Truncated : Boolean := False) is
+         Length : Natural := S'Length;
       begin
          --  If the string would not fit on the line,
          --  start a new line.
 
-         if Column + S'Length > Max_Line_Length then
-            Write_Eol.all;
-            Column := 0;
+         if Column + Length > Max_Line_Length then
+            if Truncated then
+               Length := Max_Line_Length - Column;
+
+            else
+               Write_Eol.all;
+               Column := 0;
+            end if;
          end if;
 
-         Write_Str (S);
-         Column := Column + S'Length;
+         Write_Str (S (S'First .. S'First + Length - 1));
+         Column := Column + Length;
       end Write_String;
 
       -----------
@@ -296,6 +320,7 @@ package body Prj.PP is
                      Write_Empty_Line (Always => True);
                   end if;
 
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Write_String ("project ");
                   Output_Name (Name_Of (Node));
@@ -307,21 +332,26 @@ package body Prj.PP is
                      Output_String (Extended_Project_Path_Of (Node));
                   end if;
 
-                  Write_Line (" is");
+                  Write_String (" is");
+                  Write_End_Of_Line_Comment (Node);
+                  Print (First_Comment_After (Node), Indent + Increment);
                   Write_Empty_Line (Always => True);
 
                   --  Output all of the declarations in the project
 
                   Print (Project_Declaration_Of (Node), Indent);
+                  Print (First_Comment_Before_End (Node), Indent + Increment);
                   Start_Line (Indent);
                   Write_String ("end ");
                   Output_Name (Name_Of (Node));
                   Write_Line (";");
+                  Print (First_Comment_After_End (Node), Indent);
 
                when N_With_Clause =>
                   pragma Debug (Indicate_Tested (N_With_Clause));
 
                   if Name_Of (Node) /= No_Name then
+                     Print (First_Comment_Before (Node), Indent);
                      Start_Line (Indent);
 
                      if Non_Limited_Project_Node_Of (Node) = Empty_Node then
@@ -330,7 +360,9 @@ package body Prj.PP is
 
                      Write_String ("with ");
                      Output_String (String_Value_Of (Node));
-                     Write_Line (";");
+                     Write_String (";");
+                     Write_End_Of_Line_Comment (Node);
+                     Print (First_Comment_After (Node), Indent);
                   end if;
 
                   Print (Next_With_Clause_Of (Node), Indent);
@@ -352,6 +384,7 @@ package body Prj.PP is
                when N_Package_Declaration =>
                   pragma Debug (Indicate_Tested (N_Package_Declaration));
                   Write_Empty_Line (Always => True);
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Write_String ("package ");
                   Output_Name (Name_Of (Node));
@@ -362,10 +395,14 @@ package body Prj.PP is
                        (Name_Of (Project_Of_Renamed_Package_Of (Node)));
                      Write_String (".");
                      Output_Name (Name_Of (Node));
-                     Write_Line (";");
+                     Write_String (";");
+                     Write_End_Of_Line_Comment (Node);
+                     Print (First_Comment_After_End (Node), Indent);
 
                   else
-                     Write_Line (" is");
+                     Write_String (" is");
+                     Write_End_Of_Line_Comment (Node);
+                     Print (First_Comment_After (Node), Indent + Increment);
 
                      if First_Declarative_Item_Of (Node) /= Empty_Node then
                         Print
@@ -373,15 +410,19 @@ package body Prj.PP is
                            Indent + Increment);
                      end if;
 
+                     Print (First_Comment_Before_End (Node),
+                            Indent + Increment);
                      Start_Line (Indent);
                      Write_String ("end ");
                      Output_Name (Name_Of (Node));
                      Write_Line (";");
+                     Print (First_Comment_After_End (Node), Indent);
                      Write_Empty_Line;
                   end if;
 
                when N_String_Type_Declaration =>
                   pragma Debug (Indicate_Tested (N_String_Type_Declaration));
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Write_String ("type ");
                   Output_Name (Name_Of (Node));
@@ -404,7 +445,9 @@ package body Prj.PP is
                      end loop;
                   end;
 
-                  Write_Line (");");
+                  Write_String (");");
+                  Write_End_Of_Line_Comment (Node);
+                  Print (First_Comment_After (Node), Indent);
 
                when N_Literal_String =>
                   pragma Debug (Indicate_Tested (N_Literal_String));
@@ -412,6 +455,7 @@ package body Prj.PP is
 
                when N_Attribute_Declaration =>
                   pragma Debug (Indicate_Tested (N_Attribute_Declaration));
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Write_String ("for ");
                   Output_Attribute_Name (Name_Of (Node));
@@ -424,26 +468,34 @@ package body Prj.PP is
 
                   Write_String (" use ");
                   Print (Expression_Of (Node), Indent);
-                  Write_Line (";");
+                  Write_String (";");
+                  Write_End_Of_Line_Comment (Node);
+                  Print (First_Comment_After (Node), Indent);
 
                when N_Typed_Variable_Declaration =>
                   pragma Debug
                     (Indicate_Tested (N_Typed_Variable_Declaration));
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Output_Name (Name_Of (Node));
                   Write_String (" : ");
                   Output_Name (Name_Of (String_Type_Of (Node)));
                   Write_String (" := ");
                   Print (Expression_Of (Node), Indent);
-                  Write_Line (";");
+                  Write_String (";");
+                  Write_End_Of_Line_Comment (Node);
+                  Print (First_Comment_After (Node), Indent);
 
                when N_Variable_Declaration =>
                   pragma Debug (Indicate_Tested (N_Variable_Declaration));
+                  Print (First_Comment_Before (Node), Indent);
                   Start_Line (Indent);
                   Output_Name (Name_Of (Node));
                   Write_String (" := ");
                   Print (Expression_Of (Node), Indent);
-                  Write_Line (";");
+                  Write_String (";");
+                  Write_End_Of_Line_Comment (Node);
+                  Print (First_Comment_After (Node), Indent);
 
                when N_Expression =>
                   pragma Debug (Indicate_Tested (N_Expression));
@@ -566,10 +618,13 @@ package body Prj.PP is
 
                      if Is_Non_Empty then
                         Write_Empty_Line;
+                        Print (First_Comment_Before (Node), Indent);
                         Start_Line (Indent);
                         Write_String ("case ");
                         Print (Case_Variable_Reference_Of (Node), Indent);
-                        Write_Line (" is");
+                        Write_String (" is");
+                        Write_End_Of_Line_Comment (Node);
+                        Print (First_Comment_After (Node), Indent + Increment);
 
                         declare
                            Case_Item : Project_Node_Id :=
@@ -584,8 +639,11 @@ package body Prj.PP is
                            end loop;
                         end;
 
+                        Print (First_Comment_Before_End (Node),
+                               Indent + Increment);
                         Start_Line (Indent);
                         Write_Line ("end case;");
+                        Print (First_Comment_After_End (Node), Indent);
                      end if;
                   end;
 
@@ -596,6 +654,7 @@ package body Prj.PP is
                     or else not Eliminate_Empty_Case_Constructions
                   then
                      Write_Empty_Line;
+                     Print (First_Comment_Before (Node), Indent);
                      Start_Line (Indent);
                      Write_String ("when ");
 
@@ -618,7 +677,9 @@ package body Prj.PP is
                         end;
                      end if;
 
-                     Write_Line (" =>");
+                     Write_String (" =>");
+                     Write_End_Of_Line_Comment (Node);
+                     Print (First_Comment_After (Node), Indent + Increment);
 
                      declare
                         First : constant Project_Node_Id :=
@@ -626,13 +687,39 @@ package body Prj.PP is
 
                      begin
                         if First = Empty_Node then
-                           Write_Eol.all;
+                           Write_Empty_Line;
 
                         else
                            Print (First, Indent + Increment);
                         end if;
                      end;
                   end if;
+
+               when N_Comment_Zones =>
+
+               --  Nothing to do, because it will not be processed directly
+
+                  null;
+
+               when N_Comment =>
+                  pragma Debug (Indicate_Tested (N_Comment));
+
+                  if Follows_Empty_Line (Node) then
+                     Write_Empty_Line;
+                  end if;
+
+                  Start_Line (Indent);
+                  Write_String ("--");
+                  Write_String
+                    (Get_Name_String (String_Value_Of (Node)),
+                     Truncated => True);
+                  Write_Line ("");
+
+                  if Is_Followed_By_Empty_Line (Node) then
+                     Write_Empty_Line;
+                  end if;
+
+                  Print (Next_Comment (Node), Indent);
             end case;
          end if;
       end Print;
@@ -674,7 +761,7 @@ package body Prj.PP is
       Output.Write_Line ("Project_Node_Kinds not tested:");
 
       for Kind in Project_Node_Kind loop
-         if Not_Tested (Kind) then
+         if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
             Output.Write_Str ("   ");
             Output.Write_Line (Project_Node_Kind'Image (Kind));
          end if;
Index: prj-tree.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-tree.adb,v
retrieving revision 1.8
diff -u -p -r1.8 prj-tree.adb
--- prj-tree.adb	10 Nov 2003 17:29:59 -0000	1.8
+++ prj-tree.adb	8 Dec 2003 10:31:51 -0000
@@ -24,17 +24,193 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Prj.Err;
+
 package body Prj.Tree is
 
+   Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
+     (N_Project                    => True,
+      N_With_Clause                => True,
+      N_Project_Declaration        => False,
+      N_Declarative_Item           => False,
+      N_Package_Declaration        => True,
+      N_String_Type_Declaration    => True,
+      N_Literal_String             => False,
+      N_Attribute_Declaration      => True,
+      N_Typed_Variable_Declaration => True,
+      N_Variable_Declaration       => True,
+      N_Expression                 => False,
+      N_Term                       => False,
+      N_Literal_String_List        => False,
+      N_Variable_Reference         => False,
+      N_External_Value             => False,
+      N_Attribute_Reference        => False,
+      N_Case_Construction          => True,
+      N_Case_Item                  => True,
+      N_Comment_Zones              => True,
+      N_Comment                    => True);
+   --  Indicates the kinds of node that may have associated comments
+
+   package Next_End_Nodes is new Table.Table
+     (Table_Component_Type => Project_Node_Id,
+      Table_Index_Type     => Natural,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 10,
+      Table_Increment      => 100,
+      Table_Name           => "Next_End_Nodes");
+   --  A stack of nodes to indicates to what node the next "end" is associated
+
    use Tree_Private_Part;
 
+   End_Of_Line_Node   : Project_Node_Id := Empty_Node;
+   --  The node an end of line comment may be associated with
+
+   Previous_Line_Node : Project_Node_Id := Empty_Node;
+   --  The node an immediately following comment may be associated with
+
+   Previous_End_Node  : Project_Node_Id := Empty_Node;
+   --  The node comments immediately following an "end" line may be
+   --  associated with.
+
+   Unkept_Comments    : Boolean := False;
+   --  Set to True when some comments may not be associated with any node
+
+   function Comment_Zones_Of
+     (Node : Project_Node_Id) return Project_Node_Id;
+   --  Returns the ID of the N_Comment_Zones node associated with node Node.
+   --  If there is not already an N_Comment_Zones node, create one and
+   --  associate it with node Node.
+
+   ------------------
+   -- Add_Comments --
+   ------------------
+
+   procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location) is
+      Zone     : Project_Node_Id := Empty_Node;
+      Previous : Project_Node_Id := Empty_Node;
+
+   begin
+      pragma Assert
+        (To /= Empty_Node
+          and then
+         Project_Nodes.Table (To).Kind /= N_Comment);
+
+      Zone := Project_Nodes.Table (To).Comments;
+
+      if Zone = Empty_Node then
+
+         --  Create new N_Comment_Zones node
+
+         Project_Nodes.Increment_Last;
+         Project_Nodes.Table (Project_Nodes.Last) :=
+           (Kind             => N_Comment_Zones,
+            Expr_Kind        => Undefined,
+            Location         => No_Location,
+            Directory        => No_Name,
+            Variables        => Empty_Node,
+            Packages         => Empty_Node,
+            Pkg_Id           => Empty_Package,
+            Name             => No_Name,
+            Path_Name        => No_Name,
+            Value            => No_Name,
+            Field1           => Empty_Node,
+            Field2           => Empty_Node,
+            Field3           => Empty_Node,
+            Flag1            => False,
+            Flag2            => False,
+            Comments         => Empty_Node);
+
+         Zone := Project_Nodes.Last;
+         Project_Nodes.Table (To).Comments := Zone;
+      end if;
+
+      if Where = End_Of_Line then
+         Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
+
+      else
+         --  Get each comments in the Comments table and link them to node To
+
+         for J in 1 .. Comments.Last loop
+
+            --  Create new N_Comment node
+
+            if (Where = After or else Where = After_End) and then
+              Token /= Tok_EOF and then
+              Comments.Table (J).Follows_Empty_Line
+            then
+               Comments.Table (1 .. Comments.Last - J + 1) :=
+                 Comments.Table (J .. Comments.Last);
+               Comments.Set_Last (Comments.Last - J + 1);
+               return;
+            end if;
+
+            Project_Nodes.Increment_Last;
+            Project_Nodes.Table (Project_Nodes.Last) :=
+              (Kind             => N_Comment,
+               Expr_Kind        => Undefined,
+               Flag1            => Comments.Table (J).Follows_Empty_Line,
+               Flag2            =>
+                 Comments.Table (J).Is_Followed_By_Empty_Line,
+               Location         => No_Location,
+               Directory        => No_Name,
+               Variables        => Empty_Node,
+               Packages         => Empty_Node,
+               Pkg_Id           => Empty_Package,
+               Name             => No_Name,
+               Path_Name        => No_Name,
+               Value            => Comments.Table (J).Value,
+               Field1           => Empty_Node,
+               Field2           => Empty_Node,
+               Field3           => Empty_Node,
+               Comments         => Empty_Node);
+
+            --  If this is the first comment, put it in the right field of
+            --  the node Zone.
+
+            if Previous = Empty_Node then
+               case Where is
+                  when Before =>
+                     Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
+
+                  when After =>
+                     Project_Nodes.Table (Zone).Field2 := Project_Nodes.Last;
+
+                  when Before_End =>
+                     Project_Nodes.Table (Zone).Field3 := Project_Nodes.Last;
+
+                  when After_End =>
+                     Project_Nodes.Table (Zone).Comments := Project_Nodes.Last;
+
+                  when End_Of_Line =>
+                     null;
+               end case;
+
+            else
+               --  When it is not the first, link it to the previous one
+
+               Project_Nodes.Table (Previous).Comments := Project_Nodes.Last;
+            end if;
+
+            --  This node becomes the previous one for the next comment, if
+            --  there is one.
+
+            Previous := Project_Nodes.Last;
+         end loop;
+      end if;
+
+      --  Empty the Comments table, so that there is no risk to link the same
+      --  comments to another node.
+
+      Comments.Set_Last (0);
+   end Add_Comments;
+
+
    --------------------------------
    -- Associative_Array_Index_Of --
    --------------------------------
 
    function Associative_Array_Index_Of
-     (Node : Project_Node_Id)
-      return Name_Id
+     (Node : Project_Node_Id) return Name_Id
    is
    begin
       pragma Assert
@@ -51,8 +227,7 @@ package body Prj.Tree is
    ----------------------------
 
    function Associative_Package_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -67,8 +242,7 @@ package body Prj.Tree is
    ----------------------------
 
    function Associative_Project_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -90,7 +264,7 @@ package body Prj.Tree is
             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                or else
              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
-      return Project_Nodes.Table (Node).Case_Insensitive;
+      return Project_Nodes.Table (Node).Flag1;
    end Case_Insensitive;
 
    --------------------------------
@@ -98,8 +272,7 @@ package body Prj.Tree is
    --------------------------------
 
    function Case_Variable_Reference_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -109,13 +282,54 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field1;
    end Case_Variable_Reference_Of;
 
+   ----------------------
+   -- Comment_Zones_Of --
+   ----------------------
+
+   function Comment_Zones_Of
+     (Node : Project_Node_Id) return Project_Node_Id
+   is
+      Zone : Project_Node_Id;
+
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      --  If there is not already an N_Comment_Zones associated, create a new
+      --  one and associate it with node Node.
+
+      if Zone = Empty_Node then
+         Project_Nodes.Increment_Last;
+         Zone := Project_Nodes.Last;
+         Project_Nodes.Table (Zone) :=
+        (Kind             => N_Comment_Zones,
+         Location         => No_Location,
+         Directory        => No_Name,
+         Expr_Kind        => Undefined,
+         Variables        => Empty_Node,
+         Packages         => Empty_Node,
+         Pkg_Id           => Empty_Package,
+         Name             => No_Name,
+         Path_Name        => No_Name,
+         Value            => No_Name,
+         Field1           => Empty_Node,
+         Field2           => Empty_Node,
+         Field3           => Empty_Node,
+         Flag1            => False,
+         Flag2            => False,
+         Comments         => Empty_Node);
+         Project_Nodes.Table (Node).Comments := Zone;
+      end if;
+
+      return Zone;
+   end Comment_Zones_Of;
+
    -----------------------
    -- Current_Item_Node --
    -----------------------
 
    function Current_Item_Node
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -130,8 +344,7 @@ package body Prj.Tree is
    ------------------
 
    function Current_Term
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -147,28 +360,118 @@ package body Prj.Tree is
 
    function Default_Project_Node
      (Of_Kind       : Project_Node_Kind;
-      And_Expr_Kind : Variable_Kind := Undefined)
-      return          Project_Node_Id
+      And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
    is
+      Result   : Project_Node_Id;
+      Zone     : Project_Node_Id;
+      Previous : Project_Node_Id;
+
    begin
+      --  Create new node with specified kind and expression kind
+
       Project_Nodes.Increment_Last;
       Project_Nodes.Table (Project_Nodes.Last) :=
-           (Kind             => Of_Kind,
-            Location         => No_Location,
-            Directory        => No_Name,
-            Expr_Kind        => And_Expr_Kind,
-            Variables        => Empty_Node,
-            Packages         => Empty_Node,
-            Pkg_Id           => Empty_Package,
-            Name             => No_Name,
-            Path_Name        => No_Name,
-            Value            => No_Name,
-            Field1           => Empty_Node,
-            Field2           => Empty_Node,
-            Field3           => Empty_Node,
-            Case_Insensitive => False,
-            Extending_All    => False);
-      return Project_Nodes.Last;
+        (Kind             => Of_Kind,
+         Location         => No_Location,
+         Directory        => No_Name,
+         Expr_Kind        => And_Expr_Kind,
+         Variables        => Empty_Node,
+         Packages         => Empty_Node,
+         Pkg_Id           => Empty_Package,
+         Name             => No_Name,
+         Path_Name        => No_Name,
+         Value            => No_Name,
+         Field1           => Empty_Node,
+         Field2           => Empty_Node,
+         Field3           => Empty_Node,
+         Flag1            => False,
+         Flag2            => False,
+         Comments         => Empty_Node);
+
+      --  Save the new node for the returned value
+
+      Result := Project_Nodes.Last;
+
+      if Comments.Last > 0 then
+
+         --  If this is not a node with comments, then set the flag
+
+         if not Node_With_Comments (Of_Kind) then
+            Unkept_Comments := True;
+
+         elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
+
+            Project_Nodes.Increment_Last;
+            Project_Nodes.Table (Project_Nodes.Last) :=
+              (Kind             => N_Comment_Zones,
+               Expr_Kind        => Undefined,
+               Location         => No_Location,
+               Directory        => No_Name,
+               Variables        => Empty_Node,
+               Packages         => Empty_Node,
+               Pkg_Id           => Empty_Package,
+               Name             => No_Name,
+               Path_Name        => No_Name,
+               Value            => No_Name,
+               Field1           => Empty_Node,
+               Field2           => Empty_Node,
+               Field3           => Empty_Node,
+               Flag1            => False,
+               Flag2            => False,
+               Comments         => Empty_Node);
+
+            Zone := Project_Nodes.Last;
+            Project_Nodes.Table (Result).Comments := Zone;
+            Previous := Empty_Node;
+
+            for J in 1 .. Comments.Last loop
+
+               --  Create a new N_Comment node
+
+               Project_Nodes.Increment_Last;
+               Project_Nodes.Table (Project_Nodes.Last) :=
+                 (Kind             => N_Comment,
+                  Expr_Kind        => Undefined,
+                  Flag1            => Comments.Table (J).Follows_Empty_Line,
+                  Flag2            =>
+                    Comments.Table (J).Is_Followed_By_Empty_Line,
+                  Location         => No_Location,
+                  Directory        => No_Name,
+                  Variables        => Empty_Node,
+                  Packages         => Empty_Node,
+                  Pkg_Id           => Empty_Package,
+                  Name             => No_Name,
+                  Path_Name        => No_Name,
+                  Value            => Comments.Table (J).Value,
+                  Field1           => Empty_Node,
+                  Field2           => Empty_Node,
+                  Field3           => Empty_Node,
+                  Comments         => Empty_Node);
+
+               --  Link it to the N_Comment_Zones node, if it is the first,
+               --  otherwise to the previous one.
+
+               if Previous = Empty_Node then
+                  Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
+
+               else
+                  Project_Nodes.Table (Previous).Comments :=
+                    Project_Nodes.Last;
+               end if;
+
+               --  This new node will be the previous one for the next
+               --  N_Comment node, if there is one.
+
+               Previous := Project_Nodes.Last;
+            end loop;
+
+            --  Empty the Comments table after all comments have been processed
+
+            Comments.Set_Last (0);
+         end if;
+      end if;
+
+      return Result;
    end Default_Project_Node;
 
    ------------------
@@ -184,6 +487,24 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Directory;
    end Directory_Of;
 
+   -------------------------
+   -- End_Of_Line_Comment --
+   -------------------------
+
+   function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id is
+      Zone : Project_Node_Id := Empty_Node;
+
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      if Zone = Empty_Node then
+         return No_Name;
+      else
+         return Project_Nodes.Table (Zone).Value;
+      end if;
+   end End_Of_Line_Comment;
+
    ------------------------
    -- Expression_Kind_Of --
    ------------------------
@@ -219,8 +540,7 @@ package body Prj.Tree is
    -------------------
 
    function Expression_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -240,8 +560,7 @@ package body Prj.Tree is
    -------------------------
 
    function Extended_Project_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -256,8 +575,7 @@ package body Prj.Tree is
    ------------------------------
 
    function Extended_Project_Path_Of
-     (Node : Project_Node_Id)
-      return Name_Id
+     (Node : Project_Node_Id) return Name_Id
    is
    begin
       pragma Assert
@@ -271,8 +589,7 @@ package body Prj.Tree is
    -- Extending_Project_Of --
    --------------------------
    function Extending_Project_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -287,8 +604,7 @@ package body Prj.Tree is
    ---------------------------
 
    function External_Reference_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -319,8 +635,7 @@ package body Prj.Tree is
    ------------------------
 
    function First_Case_Item_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -346,13 +661,96 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field1;
    end First_Choice_Of;
 
+   -------------------------
+   -- First_Comment_After --
+   -------------------------
+
+   function First_Comment_After
+     (Node : Project_Node_Id) return Project_Node_Id
+   is
+      Zone : Project_Node_Id := Empty_Node;
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      if Zone = Empty_Node then
+         return Empty_Node;
+
+      else
+         return Project_Nodes.Table (Zone).Field2;
+      end if;
+   end First_Comment_After;
+
+   -----------------------------
+   -- First_Comment_After_End --
+   -----------------------------
+
+   function First_Comment_After_End
+     (Node : Project_Node_Id)
+      return Project_Node_Id
+   is
+      Zone : Project_Node_Id := Empty_Node;
+
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      if Zone = Empty_Node then
+         return Empty_Node;
+
+      else
+         return Project_Nodes.Table (Zone).Comments;
+      end if;
+   end First_Comment_After_End;
+
+   --------------------------
+   -- First_Comment_Before --
+   --------------------------
+
+   function First_Comment_Before
+     (Node : Project_Node_Id) return Project_Node_Id
+   is
+      Zone : Project_Node_Id := Empty_Node;
+
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      if Zone = Empty_Node then
+         return Empty_Node;
+
+      else
+         return Project_Nodes.Table (Zone).Field1;
+      end if;
+   end First_Comment_Before;
+
+   ------------------------------
+   -- First_Comment_Before_End --
+   ------------------------------
+
+   function First_Comment_Before_End
+     (Node : Project_Node_Id) return Project_Node_Id
+   is
+      Zone : Project_Node_Id := Empty_Node;
+
+   begin
+      pragma Assert (Node /= Empty_Node);
+      Zone := Project_Nodes.Table (Node).Comments;
+
+      if Zone = Empty_Node then
+         return Empty_Node;
+
+      else
+         return Project_Nodes.Table (Zone).Field3;
+      end if;
+   end First_Comment_Before_End;
+
    -------------------------------
    -- First_Declarative_Item_Of --
    -------------------------------
 
    function First_Declarative_Item_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -376,8 +774,7 @@ package body Prj.Tree is
    ------------------------------
 
    function First_Expression_In_List
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -392,8 +789,7 @@ package body Prj.Tree is
    --------------------------
 
    function First_Literal_String
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -408,8 +804,7 @@ package body Prj.Tree is
    ----------------------
 
    function First_Package_Of
-     (Node : Project_Node_Id)
-      return Package_Declaration_Id
+     (Node : Project_Node_Id) return Package_Declaration_Id
    is
    begin
       pragma Assert
@@ -424,8 +819,7 @@ package body Prj.Tree is
    --------------------------
 
    function First_String_Type_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -440,8 +834,7 @@ package body Prj.Tree is
    ----------------
 
    function First_Term
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -456,8 +849,7 @@ package body Prj.Tree is
    -----------------------
 
    function First_Variable_Of
-     (Node : Project_Node_Id)
-      return Variable_Node_Id
+     (Node : Project_Node_Id) return Variable_Node_Id
    is
    begin
       pragma Assert
@@ -475,8 +867,7 @@ package body Prj.Tree is
    --------------------------
 
    function First_With_Clause_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -486,18 +877,18 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field1;
    end First_With_Clause_Of;
 
-   ----------------------
-   -- Is_Extending_All --
-   ----------------------
+   ------------------------
+   -- Follows_Empty_Line --
+   ------------------------
 
-   function Is_Extending_All (Node  : Project_Node_Id) return Boolean is
+   function Follows_Empty_Line (Node : Project_Node_Id) return Boolean is
    begin
       pragma Assert
         (Node /= Empty_Node
-          and then
-            Project_Nodes.Table (Node).Kind = N_Project);
-      return Project_Nodes.Table (Node).Extending_All;
-   end Is_Extending_All;
+         and then
+         Project_Nodes.Table (Node).Kind = N_Comment);
+      return Project_Nodes.Table (Node).Flag1;
+   end Follows_Empty_Line;
 
    ----------
    -- Hash --
@@ -508,14 +899,51 @@ package body Prj.Tree is
       return Header_Num (N mod Project_Node_Id (Header_Num'Last));
    end Hash;
 
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Project_Nodes.Set_Last (Empty_Node);
+      Projects_Htable.Reset;
+   end Initialize;
+
+   -------------------------------
+   -- Is_Followed_By_Empty_Line --
+   -------------------------------
+
+   function Is_Followed_By_Empty_Line
+     (Node : Project_Node_Id) return Boolean
+   is
+   begin
+      pragma Assert
+        (Node /= Empty_Node
+          and then
+            Project_Nodes.Table (Node).Kind = N_Comment);
+      return Project_Nodes.Table (Node).Flag2;
+   end Is_Followed_By_Empty_Line;
+
+   ----------------------
+   -- Is_Extending_All --
+   ----------------------
+
+   function Is_Extending_All (Node  : Project_Node_Id) return Boolean is
+   begin
+      pragma Assert
+        (Node /= Empty_Node
+          and then
+            Project_Nodes.Table (Node).Kind = N_Project);
+      return Project_Nodes.Table (Node).Flag2;
+   end Is_Extending_All;
+
    -------------------------------------
    -- Imported_Or_Extended_Project_Of --
    -------------------------------------
 
    function Imported_Or_Extended_Project_Of
      (Project   : Project_Node_Id;
-      With_Name : Name_Id)
-      return      Project_Node_Id
+      With_Name : Name_Id) return Project_Node_Id
    is
       With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
       Result      : Project_Node_Id := Empty_Node;
@@ -548,16 +976,6 @@ package body Prj.Tree is
       return Result;
    end Imported_Or_Extended_Project_Of;
 
-   ----------------
-   -- Initialize --
-   ----------------
-
-   procedure Initialize is
-   begin
-      Project_Nodes.Set_Last (Empty_Node);
-      Projects_Htable.Reset;
-   end Initialize;
-
    -------------
    -- Kind_Of --
    -------------
@@ -593,8 +1011,7 @@ package body Prj.Tree is
    --------------------
 
    function Next_Case_Item
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -604,13 +1021,25 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field3;
    end Next_Case_Item;
 
+   ------------------
+   -- Next_Comment --
+   ------------------
+
+   function Next_Comment (Node : Project_Node_Id) return Project_Node_Id is
+   begin
+      pragma Assert
+        (Node /= Empty_Node
+          and then
+            Project_Nodes.Table (Node).Kind = N_Comment);
+      return Project_Nodes.Table (Node).Comments;
+   end Next_Comment;
+
    ---------------------------
    -- Next_Declarative_Item --
    ---------------------------
 
    function Next_Declarative_Item
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -625,8 +1054,7 @@ package body Prj.Tree is
    -----------------------------
 
    function Next_Expression_In_List
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -657,8 +1085,7 @@ package body Prj.Tree is
    -----------------------------
 
    function Next_Package_In_Project
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -689,8 +1116,7 @@ package body Prj.Tree is
    ---------------
 
    function Next_Term
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -724,8 +1150,7 @@ package body Prj.Tree is
    -------------------------
 
    function Next_With_Clause_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -740,8 +1165,7 @@ package body Prj.Tree is
    ---------------------------------
 
    function Non_Limited_Project_Node_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -750,6 +1174,7 @@ package body Prj.Tree is
            (Project_Nodes.Table (Node).Kind = N_With_Clause));
       return Project_Nodes.Table (Node).Field3;
    end Non_Limited_Project_Node_Of;
+
    -------------------
    -- Package_Id_Of --
    -------------------
@@ -768,8 +1193,7 @@ package body Prj.Tree is
    ---------------------
 
    function Package_Node_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -801,8 +1225,7 @@ package body Prj.Tree is
    ----------------------------
 
    function Project_Declaration_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -812,13 +1235,25 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field2;
    end Project_Declaration_Of;
 
+   -------------------------------------------
+   -- Project_File_Includes_Unkept_Comments --
+   -------------------------------------------
+
+   function Project_File_Includes_Unkept_Comments
+     (Node : Project_Node_Id) return Boolean
+   is
+      Declaration : constant Project_Node_Id :=
+        Project_Declaration_Of (Node);
+   begin
+      return Project_Nodes.Table (Declaration).Flag1;
+   end Project_File_Includes_Unkept_Comments;
+
    ---------------------
    -- Project_Node_Of --
    ---------------------
 
    function Project_Node_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -837,8 +1272,7 @@ package body Prj.Tree is
    -----------------------------------
 
    function Project_Of_Renamed_Package_Of
-     (Node : Project_Node_Id)
-      return Project_Node_Id
+     (Node : Project_Node_Id) return Project_Node_Id
    is
    begin
       pragma Assert
@@ -848,6 +1282,181 @@ package body Prj.Tree is
       return Project_Nodes.Table (Node).Field1;
    end Project_Of_Renamed_Package_Of;
 
+   --------------------------
+   -- Remove_Next_End_Node --
+   --------------------------
+
+   procedure Remove_Next_End_Node is
+   begin
+      Next_End_Nodes.Decrement_Last;
+   end Remove_Next_End_Node;
+
+   -----------------
+   -- Reset_State --
+   -----------------
+
+   procedure Reset_State is
+   begin
+      End_Of_Line_Node   := Empty_Node;
+      Previous_Line_Node := Empty_Node;
+      Previous_End_Node  := Empty_Node;
+      Unkept_Comments    := False;
+      Comments.Set_Last (0);
+   end Reset_State;
+
+   -------------
+   -- Restore --
+   -------------
+
+   procedure Restore (S : in Comment_State) is
+   begin
+      End_Of_Line_Node   := S.End_Of_Line_Node;
+      Previous_Line_Node := S.Previous_Line_Node;
+      Previous_End_Node  := S.Previous_End_Node;
+      Next_End_Nodes.Set_Last (0);
+      Unkept_Comments    := S.Unkept_Comments;
+
+      Comments.Set_Last (0);
+
+      for J in S.Comments'Range loop
+         Comments.Increment_Last;
+         Comments.Table (Comments.Last) := S.Comments (J);
+      end loop;
+   end Restore;
+
+   ----------
+   -- Save --
+   ----------
+
+   procedure Save (S : out Comment_State) is
+      Cmts : Comments_Ptr := new Comment_Array (1 .. Comments.Last);
+   begin
+      for J in 1 .. Comments.Last loop
+         Cmts (J) := Comments.Table (J);
+      end loop;
+
+      S :=
+        (End_Of_Line_Node   => End_Of_Line_Node,
+         Previous_Line_Node => Previous_Line_Node,
+         Previous_End_Node  => Previous_End_Node,
+         Unkept_Comments    => Unkept_Comments,
+         Comments           => Cmts);
+   end Save;
+
+   ----------
+   -- Scan --
+   ----------
+
+   procedure Scan is
+      Empty_Line : Boolean := False;
+   begin
+      --  If there are comments, then they will not be kept. Set the flag and
+      --  clear the comments.
+
+      if Comments.Last > 0 then
+         Unkept_Comments := True;
+         Comments.Set_Last (0);
+      end if;
+
+      --  Loop until a token other that End_Of_Line or Comment is found
+
+      loop
+         Prj.Err.Scanner.Scan;
+
+         case Token is
+            when Tok_End_Of_Line =>
+               if Prev_Token = Tok_End_Of_Line then
+                  Empty_Line := True;
+
+                  if Comments.Last > 0 then
+                     Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
+                     := True;
+                  end if;
+               end if;
+
+            when Tok_Comment =>
+               --  If this is a line comment, add it to the comment table
+
+               if Prev_Token = Tok_End_Of_Line
+                 or else Prev_Token = No_Token
+               then
+                  Comments.Increment_Last;
+                  Comments.Table (Comments.Last) :=
+                    (Value                     => Comment_Id,
+                     Follows_Empty_Line        => Empty_Line,
+                     Is_Followed_By_Empty_Line => False);
+
+               --  Otherwise, it is an end of line comment. If there is
+               --  an end of line node specified, associate the comment with
+               --  this node.
+
+               elsif End_Of_Line_Node /= Empty_Node then
+                  declare
+                     Zones : constant Project_Node_Id :=
+                       Comment_Zones_Of (End_Of_Line_Node);
+                  begin
+                     Project_Nodes.Table (Zones).Value := Comment_Id;
+                  end;
+
+               --  Otherwise, this end of line node cannot be kept
+
+               else
+                  Unkept_Comments := True;
+                  Comments.Set_Last (0);
+               end if;
+
+               Empty_Line := False;
+
+            when others =>
+               --  If there are comments, where the first comment is not
+               --  following an empty line, put the initial uninterrupted
+               --  comment zone with the node of the preceding line (either
+               --  a Previous_Line or a Previous_End node), if any.
+
+               if Comments.Last > 0 and then
+                 not Comments.Table (1).Follows_Empty_Line then
+                  if Previous_Line_Node /= Empty_Node then
+                     Add_Comments
+                       (To => Previous_Line_Node, Where => After);
+
+                  elsif Previous_End_Node /= Empty_Node then
+                     Add_Comments
+                       (To => Previous_End_Node, Where => After_End);
+                  end if;
+               end if;
+
+               --  If there are still comments and the token is "end", then
+               --  put these comments with the Next_End node, if any;
+               --  otherwise, these comments cannot be kept. Always clear
+               --  the comments.
+
+               if Comments.Last > 0 and then Token = Tok_End then
+                  if Next_End_Nodes.Last > 0 then
+                     Add_Comments
+                       (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
+                        Where => Before_End);
+
+                  else
+                     Unkept_Comments := True;
+                  end if;
+
+                  Comments.Set_Last (0);
+               end if;
+
+               --  Reset the End_Of_Line, Previous_Line and Previous_End nodes
+               --  so that they are not used again.
+
+               End_Of_Line_Node   := Empty_Node;
+               Previous_Line_Node := Empty_Node;
+               Previous_End_Node  := Empty_Node;
+
+               --  And return
+
+               exit;
+         end case;
+      end loop;
+   end Scan;
+
    ------------------------------------
    -- Set_Associative_Array_Index_Of --
    ------------------------------------
@@ -913,7 +1522,7 @@ package body Prj.Tree is
            (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                or else
             Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
-      Project_Nodes.Table (Node).Case_Insensitive := To;
+      Project_Nodes.Table (Node).Flag1 := To;
    end Set_Case_Insensitive;
 
    ------------------------------------
@@ -980,6 +1589,15 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Directory := To;
    end Set_Directory_Of;
 
+   ---------------------
+   -- Set_End_Of_Line --
+   ---------------------
+
+   procedure Set_End_Of_Line (To : Project_Node_Id) is
+   begin
+      End_Of_Line_Node := To;
+   end Set_End_Of_Line;
+
    ----------------------------
    -- Set_Expression_Kind_Of --
    ----------------------------
@@ -1096,6 +1714,63 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Field1 := To;
    end Set_First_Choice_Of;
 
+   -----------------------------
+   -- Set_First_Comment_After --
+   -----------------------------
+
+   procedure Set_First_Comment_After
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id)
+   is
+      Zone : constant Project_Node_Id :=
+                Comment_Zones_Of (Node);
+   begin
+      Project_Nodes.Table (Zone).Field2 := To;
+   end Set_First_Comment_After;
+
+   ---------------------------------
+   -- Set_First_Comment_After_End --
+   ---------------------------------
+
+   procedure Set_First_Comment_After_End
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id)
+   is
+      Zone : constant Project_Node_Id :=
+                Comment_Zones_Of (Node);
+   begin
+      Project_Nodes.Table (Zone).Comments := To;
+   end Set_First_Comment_After_End;
+
+   ------------------------------
+   -- Set_First_Comment_Before --
+   ------------------------------
+
+   procedure Set_First_Comment_Before
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id)
+
+   is
+      Zone : constant Project_Node_Id :=
+                Comment_Zones_Of (Node);
+   begin
+      Project_Nodes.Table (Zone).Field1 := To;
+   end Set_First_Comment_Before;
+
+   ----------------------------------
+   -- Set_First_Comment_Before_End --
+   ----------------------------------
+
+   procedure Set_First_Comment_Before_End
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id)
+   is
+      Zone : constant Project_Node_Id :=
+                Comment_Zones_Of (Node);
+   begin
+      Project_Nodes.Table (Zone).Field2 := To;
+   end Set_First_Comment_Before_End;
+
    ------------------------
    -- Set_Next_Case_Item --
    ------------------------
@@ -1112,6 +1787,22 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Field3 := To;
    end Set_Next_Case_Item;
 
+   ----------------------
+   -- Set_Next_Comment --
+   ----------------------
+
+   procedure Set_Next_Comment
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id)
+   is
+   begin
+      pragma Assert
+        (Node /= Empty_Node
+          and then
+            Project_Nodes.Table (Node).Kind = N_Comment);
+      Project_Nodes.Table (Node).Comments := To;
+   end Set_Next_Comment;
+
    -----------------------------------
    -- Set_First_Declarative_Item_Of --
    -----------------------------------
@@ -1261,7 +1952,7 @@ package body Prj.Tree is
         (Node /= Empty_Node
           and then
             Project_Nodes.Table (Node).Kind = N_Project);
-      Project_Nodes.Table (Node).Extending_All := True;
+      Project_Nodes.Table (Node).Flag2 := True;
    end Set_Is_Extending_All;
 
    -----------------
@@ -1367,6 +2058,16 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Field2 := To;
    end Set_Next_Declarative_Item;
 
+   -----------------------
+   -- Set_Next_End_Node --
+   -----------------------
+
+   procedure Set_Next_End_Node (To : Project_Node_Id) is
+   begin
+      Next_End_Nodes.Increment_Last;
+      Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
+   end Set_Next_End_Node;
+
    ---------------------------------
    -- Set_Next_Expression_In_List --
    ---------------------------------
@@ -1533,6 +2234,23 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Path_Name := To;
    end Set_Path_Name_Of;
 
+   ---------------------------
+   -- Set_Previous_End_Node --
+   ---------------------------
+   procedure Set_Previous_End_Node (To : Project_Node_Id) is
+   begin
+      Previous_End_Node := To;
+   end Set_Previous_End_Node;
+
+   ----------------------------
+   -- Set_Previous_Line_Node --
+   ----------------------------
+
+   procedure Set_Previous_Line_Node (To : Project_Node_Id) is
+   begin
+      Previous_Line_Node := To;
+   end Set_Previous_Line_Node;
+
    --------------------------------
    -- Set_Project_Declaration_Of --
    --------------------------------
@@ -1549,6 +2267,20 @@ package body Prj.Tree is
       Project_Nodes.Table (Node).Field2 := To;
    end Set_Project_Declaration_Of;
 
+   -----------------------------------------------
+   -- Set_Project_File_Includes_Unkept_Comments --
+   -----------------------------------------------
+
+   procedure Set_Project_File_Includes_Unkept_Comments
+     (Node : Project_Node_Id;
+      To   : Boolean)
+   is
+      Declaration : constant Project_Node_Id :=
+        Project_Declaration_Of (Node);
+   begin
+      Project_Nodes.Table (Declaration).Flag1 := To;
+   end Set_Project_File_Includes_Unkept_Comments;
+
    -------------------------
    -- Set_Project_Node_Of --
    -------------------------
@@ -1631,6 +2363,8 @@ package body Prj.Tree is
           and then
             (Project_Nodes.Table (Node).Kind = N_With_Clause
                or else
+             Project_Nodes.Table (Node).Kind = N_Comment
+               or else
              Project_Nodes.Table (Node).Kind = N_Literal_String));
       Project_Nodes.Table (Node).Value := To;
    end Set_String_Value_Of;
@@ -1639,8 +2373,9 @@ package body Prj.Tree is
    -- String_Type_Of --
    --------------------
 
-   function String_Type_Of  (Node : Project_Node_Id)
-                            return Project_Node_Id is
+   function String_Type_Of
+     (Node : Project_Node_Id) return Project_Node_Id
+   is
    begin
       pragma Assert
         (Node /= Empty_Node
@@ -1667,6 +2402,8 @@ package body Prj.Tree is
           and then
            (Project_Nodes.Table (Node).Kind = N_With_Clause
               or else
+            Project_Nodes.Table (Node).Kind = N_Comment
+               or else
             Project_Nodes.Table (Node).Kind = N_Literal_String));
       return Project_Nodes.Table (Node).Value;
    end String_Value_Of;
@@ -1677,8 +2414,7 @@ package body Prj.Tree is
 
    function Value_Is_Valid
      (For_Typed_Variable : Project_Node_Id;
-      Value              : Name_Id)
-      return               Boolean
+      Value              : Name_Id) return Boolean
    is
    begin
       pragma Assert
@@ -1705,5 +2441,15 @@ package body Prj.Tree is
       end;
 
    end Value_Is_Valid;
+
+   -------------------------------
+   -- There_Are_Unkept_Comments --
+   -------------------------------
+
+   function There_Are_Unkept_Comments return Boolean is
+   begin
+      return Unkept_Comments;
+   end There_Are_Unkept_Comments;
+
 
 end Prj.Tree;
Index: prj-tree.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-tree.ads,v
retrieving revision 1.10
diff -u -p -r1.10 prj-tree.ads
--- prj-tree.ads	10 Nov 2003 17:29:59 -0000	1.10
+++ prj-tree.ads	8 Dec 2003 10:31:51 -0000
@@ -30,8 +30,8 @@ with GNAT.HTable;
 
 with Prj.Attr; use Prj.Attr;
 with Prj.Com;  use Prj.Com;
+with Table;    use Table;
 with Types;    use Types;
-with Table;
 
 package Prj.Tree is
 
@@ -79,7 +79,9 @@ package Prj.Tree is
       N_External_Value,
       N_Attribute_Reference,
       N_Case_Construction,
-      N_Case_Item);
+      N_Case_Item,
+      N_Comment_Zones,
+      N_Comment);
    --  Each node in the tree is of a Project_Node_Kind
    --  For the signification of the fields in each node of a
    --  Project_Node_Kind, look at package Tree_Private_Part.
@@ -90,8 +92,7 @@ package Prj.Tree is
 
    function Default_Project_Node
      (Of_Kind       : Project_Node_Kind;
-      And_Expr_Kind : Variable_Kind := Undefined)
-      return          Project_Node_Id;
+      And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
    --  Returns a Project_Node_Record with the specified Kind and
    --  Expr_Kind; all the other components have default nil values.
 
@@ -100,11 +101,85 @@ package Prj.Tree is
 
    function Imported_Or_Extended_Project_Of
      (Project   : Project_Node_Id;
-      With_Name : Name_Id)
-      return      Project_Node_Id;
+      With_Name : Name_Id) return Project_Node_Id;
    --  Return the node of a project imported or extended by project Project and
    --  whose name is With_Name. Return Empty_Node if there is no such project.
 
+   --------------
+   -- Comments --
+   --------------
+
+   type Comment_State is private;
+   --  A type to store the values of several global variables related to
+   --  comments.
+
+   procedure Save (S : out Comment_State);
+   --  Save in variable S the comment state. Called before scanning a new
+   --  project file.
+
+   procedure Restore (S : in Comment_State);
+   --  Restore the comment state to a previously saved value. Called after
+   --  scanning a project file.
+
+   procedure Reset_State;
+   --  Set the comment state to its initial value. Called before scanning a
+   --  new project file.
+
+   function There_Are_Unkept_Comments return Boolean;
+   --  Indicates that some of the comments in a project file could not be
+   --  stored in the parse tree.
+
+   procedure Set_Previous_Line_Node (To : Project_Node_Id);
+   --  Indicate the node on the previous line. If there are comments
+   --  immediately following this line, then they should be associated with
+   --  this node.
+
+   procedure Set_Previous_End_Node (To : Project_Node_Id);
+   --  Indicate that on the previous line the "end" belongs to node To.
+   --  If there are comments immediately following this "end" line, they
+   --  should be associated with this node.
+
+   procedure Set_End_Of_Line (To : Project_Node_Id);
+   --  Indicate the node on the current line. If there is an end of line
+   --  comment, then it should be associated with this node.
+
+   procedure Set_Next_End_Node (To : Project_Node_Id);
+   --  Put node To on the top of the end node stack. When an "end" line
+   --  is found with this node on the top of the end node stack, the comments,
+   --  if any, immediately preceding this "end" line will be associated with
+   --  this node.
+
+   procedure Remove_Next_End_Node;
+   --  Remove the top of the end node stack.
+
+   ------------------------
+   -- Comment Processing --
+   ------------------------
+
+   type Comment_Data is record
+      Value                     : Name_Id := No_Name;
+      Follows_Empty_Line        : Boolean := False;
+      Is_Followed_By_Empty_Line : Boolean := False;
+   end record;
+
+   package Comments is new Table.Table
+     (Table_Component_Type => Comment_Data,
+      Table_Index_Type     => Natural,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 10,
+      Table_Increment      => 100,
+      Table_Name           => "Prj.Tree.Comments");
+   --  A table to store the comments that may be stored is the tree
+
+   procedure Scan;
+   --  Scan the tokens and accumulate comments.
+
+   type Comment_Location is
+     (Before, After, Before_End, After_End, End_Of_Line);
+
+   procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location);
+   --  Add comments to this node.
+
    ----------------------
    -- Access Functions --
    ----------------------
@@ -125,6 +200,39 @@ package Prj.Tree is
    pragma Inline (Location_Of);
    --  Valid for all non empty nodes
 
+   function First_Comment_After
+     (Node : Project_Node_Id) return Project_Node_Id;
+   --  Valid only for N_Comment_Zones nodes
+
+   function First_Comment_After_End
+     (Node : Project_Node_Id) return Project_Node_Id;
+   --  Valid only for N_Comment_Zones nodes
+
+   function First_Comment_Before
+     (Node : Project_Node_Id) return Project_Node_Id;
+   --  Valid only for N_Comment_Zones nodes
+
+   function First_Comment_Before_End
+     (Node : Project_Node_Id) return Project_Node_Id;
+   --  Valid only for N_Comment_Zones nodes
+
+   function Next_Comment (Node : Project_Node_Id) return Project_Node_Id;
+   --  Valid only for N_Comment nodes
+
+   function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id;
+   --  Valid only for non empty nodes
+
+   function Follows_Empty_Line (Node : Project_Node_Id) return Boolean;
+   --  Valid only for N_Comment nodes
+
+   function Is_Followed_By_Empty_Line (Node : Project_Node_Id) return Boolean;
+   --  Valid only for N_Comment nodes
+
+   function Project_File_Includes_Unkept_Comments
+     (Node : Project_Node_Id)
+      return Boolean;
+   --  Valid only for N_Project nodes
+
    function Directory_Of (Node : Project_Node_Id) return Name_Id;
    pragma Inline (Directory_Of);
    --  Only valid for N_Project nodes.
@@ -140,14 +248,12 @@ package Prj.Tree is
    --  Only valid for N_Project
 
    function First_Variable_Of
-     (Node  : Project_Node_Id)
-      return  Variable_Node_Id;
+     (Node : Project_Node_Id) return Variable_Node_Id;
    pragma Inline (First_Variable_Of);
    --  Only valid for N_Project or N_Package_Declaration nodes
 
    function First_Package_Of
-     (Node  : Project_Node_Id)
-      return  Package_Declaration_Id;
+     (Node : Project_Node_Id) return Package_Declaration_Id;
    pragma Inline (First_Package_Of);
    --  Only valid for N_Project nodes
 
@@ -155,123 +261,105 @@ package Prj.Tree is
    pragma Inline (Package_Id_Of);
    --  Only valid for N_Package_Declaration nodes
 
-   function Path_Name_Of (Node  : Project_Node_Id) return Name_Id;
+   function Path_Name_Of (Node : Project_Node_Id) return Name_Id;
    pragma Inline (Path_Name_Of);
    --  Only valid for N_Project and N_With_Clause nodes.
 
-   function String_Value_Of (Node  : Project_Node_Id) return Name_Id;
+   function String_Value_Of (Node : Project_Node_Id) return Name_Id;
    pragma Inline (String_Value_Of);
-   --  Only valid for N_With_Clause or N_Literal_String nodes.
+   --  Only valid for N_With_Clause, N_Literal_String nodes or N_Comment
 
    function First_With_Clause_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_With_Clause_Of);
    --  Only valid for N_Project nodes
 
    function Project_Declaration_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Project_Declaration_Of);
    --  Only valid for N_Project nodes
 
    function Extending_Project_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Extending_Project_Of);
    --  Only valid for N_Project_Declaration nodes
 
    function First_String_Type_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_String_Type_Of);
    --  Only valid for N_Project nodes
 
    function Extended_Project_Path_Of
-     (Node  : Project_Node_Id)
-      return  Name_Id;
+     (Node : Project_Node_Id) return Name_Id;
    pragma Inline (Extended_Project_Path_Of);
    --  Only valid for N_With_Clause nodes
 
    function Project_Node_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Project_Node_Of);
    --  Only valid for N_With_Clause, N_Variable_Reference and
    --  N_Attribute_Reference nodes.
 
    function Non_Limited_Project_Node_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Non_Limited_Project_Node_Of);
    --  Only valid for N_With_Clause nodes. Returns Empty_Node for limited
    --  imported project files, otherwise returns the same result as
    --  Project_Node_Of.
 
    function Next_With_Clause_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_With_Clause_Of);
    --  Only valid for N_With_Clause nodes
 
    function First_Declarative_Item_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Declarative_Item_Of);
    --  Only valid for N_With_Clause nodes
 
    function Extended_Project_Of
-     (Node  : Project_Node_Id)
-      return Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Extended_Project_Of);
    --  Only valid for N_Project_Declaration nodes
 
    function Current_Item_Node
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Current_Item_Node);
    --  Only valid for N_Declarative_Item nodes
 
    function Next_Declarative_Item
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Declarative_Item);
    --  Only valid for N_Declarative_Item node
 
    function Project_Of_Renamed_Package_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Project_Of_Renamed_Package_Of);
    --  Only valid for N_Package_Declaration nodes.
    --  May return Empty_Node.
 
    function Next_Package_In_Project
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Package_In_Project);
    --  Only valid for N_Package_Declaration nodes
 
    function First_Literal_String
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Literal_String);
    --  Only valid for N_String_Type_Declaration nodes
 
    function Next_String_Type
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_String_Type);
    --  Only valid for N_String_Type_Declaration nodes
 
    function Next_Literal_String
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Literal_String);
    --  Only valid for N_Literal_String nodes
 
    function Expression_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Expression_Of);
    --  Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
    --  or N_Variable_Declaration nodes
@@ -290,104 +378,88 @@ package Prj.Tree is
 
    function Value_Is_Valid
      (For_Typed_Variable : Project_Node_Id;
-      Value              : Name_Id)
-      return               Boolean;
+      Value              : Name_Id) return Boolean;
    pragma Inline (Value_Is_Valid);
    --  Only valid for N_Typed_Variable_Declaration. Returns True if Value is
    --  in the list of allowed strings for For_Typed_Variable. False otherwise.
 
    function Associative_Array_Index_Of
-     (Node  : Project_Node_Id)
-      return  Name_Id;
+     (Node : Project_Node_Id) return Name_Id;
    pragma Inline (Associative_Array_Index_Of);
    --  Only valid for N_Attribute_Declaration and N_Attribute_Reference.
    --  Returns No_String for non associative array attributes.
 
    function Next_Variable
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Variable);
    --  Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
    --  nodes.
 
    function First_Term
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Term);
    --  Only valid for N_Expression nodes
 
    function Next_Expression_In_List
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Expression_In_List);
    --  Only valid for N_Expression nodes
 
    function Current_Term
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Current_Term);
    --  Only valid for N_Term nodes
 
    function Next_Term
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Term);
    --  Only valid for N_Term nodes
 
    function First_Expression_In_List
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Expression_In_List);
    --  Only valid for N_Literal_String_List nodes
 
    function Package_Node_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Package_Node_Of);
    --  Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
    --  May return Empty_Node.
 
    function String_Type_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (String_Type_Of);
    --  Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
    --  nodes.
 
    function External_Reference_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (External_Reference_Of);
    --  Only valid for N_External_Value nodes
 
    function External_Default_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (External_Default_Of);
    --  Only valid for N_External_Value nodes
 
    function Case_Variable_Reference_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Case_Variable_Reference_Of);
    --  Only valid for N_Case_Construction nodes
 
    function First_Case_Item_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Case_Item_Of);
    --  Only valid for N_Case_Construction nodes
 
    function First_Choice_Of
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (First_Choice_Of);
    --  Return the first choice in a N_Case_Item, or Empty_Node if
    --  this is when others.
 
    function Next_Case_Item
-     (Node  : Project_Node_Id)
-      return  Project_Node_Id;
+     (Node : Project_Node_Id) return Project_Node_Id;
    pragma Inline (Next_Case_Item);
    --  Only valid for N_Case_Item nodes
 
@@ -419,6 +491,35 @@ package Prj.Tree is
       To   : Source_Ptr);
    pragma Inline (Set_Location_Of);
 
+   procedure Set_First_Comment_After
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id);
+   pragma Inline (Set_First_Comment_After);
+
+   procedure Set_First_Comment_After_End
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id);
+   pragma Inline (Set_First_Comment_After_End);
+
+   procedure Set_First_Comment_Before
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id);
+   pragma Inline (Set_First_Comment_Before);
+
+   procedure Set_First_Comment_Before_End
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id);
+   pragma Inline (Set_First_Comment_Before_End);
+
+   procedure Set_Next_Comment
+     (Node : Project_Node_Id;
+      To   : Project_Node_Id);
+   pragma Inline (Set_Next_Comment);
+
+   procedure Set_Project_File_Includes_Unkept_Comments
+     (Node : Project_Node_Id;
+      To   : Boolean);
+
    procedure Set_Directory_Of
      (Node : Project_Node_Id;
       To   : Name_Id);
@@ -687,14 +788,32 @@ package Prj.Tree is
          Field3 : Project_Node_Id := Empty_Node;
          --  See below the meaning for each Project_Node_Kind
 
-         Case_Insensitive : Boolean := False;
-         --  This flag is significant only for N_Attribute_Declaration and
-         --  N_Atribute_Reference. It indicates for an associative array
-         --  attribute, that the index is case insensitive.
-
-         Extending_All : Boolean := False;
-         --  This flag is significant only for N_Project. It indicates that
-         --  the project "extends all" another project.
+         Flag1 : Boolean := False;
+         --  This flag is significant only for:
+         --    N_Attribute_Declaration and N_Atribute_Reference
+         --      It indicates for an associative array attribute, that the
+         --      index is case insensitive.
+         --    N_Comment - it indicates that the comment is preceded by an
+         --                empty line.
+         --    N_Project - it indicates that there are comments in the project
+         --                source that cannot be kept in the tree.
+         --    N_Project_Declaration
+         --              - it indixates that there are unkept comment in the
+         --                project.
+
+         Flag2 : Boolean := False;
+         --  This flag is significant only for:
+         --    N_Project - it indicates that the project "extends all" another
+         --                project.
+         --    N_Comment - it indicates that the comment is followed by an
+         --                empty line.
+
+         Comments : Project_Node_Id := Empty_Node;
+         --  For nodes other that N_Comment_Zones or N_Comment, designates the
+         --  comment zones associated with the node.
+         --  for N_Comment_Zones, designates the comment after the "end" of
+         --  the construct.
+         --  For N_Comment, designates the next comment, if any.
 
       end record;
 
@@ -862,7 +981,7 @@ package Prj.Tree is
       --    --  Field3:    not used
       --    --  Value:     not used
 
-      --    N_Case_Item);
+      --    N_Case_Item
       --    --  Name:      not used
       --    --  Path_Name: not used
       --    --  Expr_Kind: not used
@@ -872,6 +991,28 @@ package Prj.Tree is
       --    --  Field3:    next case item
       --    --  Value:     not used
 
+      --    N_Comment_zones
+      --    --  Name:      not used
+      --    --  Path_Name: not used
+      --    --  Expr_Kind: not used
+      --    --  Field1:    comment before the construct
+      --    --  Field2:    comment after the construct
+      --    --  Field3:    comment before the "end" of the construct
+      --    --  Value:     end of line comment
+      --    --  Comments:  comment after the "end" of the construct
+
+      --    N_Comment
+      --    --  Name:      not used
+      --    --  Path_Name: not used
+      --    --  Expr_Kind: not used
+      --    --  Field1:    not used
+      --    --  Field2:    not used
+      --    --  Field3:    not used
+      --    --  Value:     comment
+      --    --  Flag1:     comment is preceded by an empty line
+      --    --  Flag2:     comment is followed by an empty line
+      --    --  Comments:  next comment
+
       package Project_Nodes is
          new Table.Table (Table_Component_Type => Project_Node_Record,
                           Table_Index_Type     => Project_Node_Id,
@@ -910,5 +1051,21 @@ package Prj.Tree is
       --  its name.
 
    end Tree_Private_Part;
+
+private
+   type Comment_Array is array (Positive range <>) of Comment_Data;
+   type Comments_Ptr is access Comment_Array;
+
+   type Comment_State is record
+      End_Of_Line_Node   : Project_Node_Id := Empty_Node;
+
+      Previous_Line_Node : Project_Node_Id := Empty_Node;
+
+      Previous_End_Node  : Project_Node_Id := Empty_Node;
+
+      Unkept_Comments    : Boolean := False;
+
+      Comments           : Comments_Ptr := null;
+   end record;
 
 end Prj.Tree;
Index: scans.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/scans.ads,v
retrieving revision 1.8
diff -u -p -r1.8 scans.ads
--- scans.ads	21 Oct 2003 13:42:18 -0000	1.8
+++ scans.ads	8 Dec 2003 10:31:51 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -187,15 +187,21 @@ package Scans is
 
       Tok_Dot_Dot,         -- ..           Sterm, Chtok
 
-      --  The following three entries are used only when scanning
-      --  project files.
+      --  The following three entries are used only when scanning project
+      --  files.
 
       Tok_Project,
       Tok_Extends,
       Tok_External,
+      Tok_Comment,
+
+      --  The following entry is used by the preprocessor and when scanning
+      --  project files.
 
-      --  The following two entries are used by the preprocessor
       Tok_End_Of_Line,
+
+      --  The following entry is used by the preprocessor
+
       Tok_Special,
 
       No_Token);
@@ -403,6 +409,10 @@ package Scans is
 
    Special_Character : Character;
    --  Valid only when Token = Tok_Special
+
+   Comment_Id : Name_Id := No_Name;
+   --  Valid only when Token = Tok_Comment. Store the string that follows
+   --  the two '-' of a comment.
 
    --------------------------------------------------------
    -- Procedures for Saving and Restoring the Scan State --
Index: scng.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/scng.adb,v
retrieving revision 1.1
diff -u -p -r1.1 scng.adb
--- scng.adb	21 Oct 2003 13:42:18 -0000	1.1
+++ scng.adb	8 Dec 2003 10:31:51 -0000
@@ -49,6 +49,9 @@ package body Scng is
    Special_Characters : array (Character) of Boolean := (others => False);
    --  For characters that are Special token, the value is True
 
+   Comment_Is_Token : Boolean := False;
+   --  True if comments are tokens
+
    End_Of_Line_Is_Token : Boolean := False;
    --  True if End_Of_Line is a token
 
@@ -229,6 +232,8 @@ package body Scng is
 
    procedure Scan is
 
+      Start_Of_Comment : Source_Ptr;
+
       procedure Check_End_Of_Line;
       --  Called when end of line encountered. Checks that line is not
       --  too long, and that other style checks for the end of line are met.
@@ -1394,6 +1399,7 @@ package body Scng is
             else -- Source (Scan_Ptr + 1) = '-' then
                if Style_Check then Style.Check_Comment; end if;
                Scan_Ptr := Scan_Ptr + 2;
+               Start_Of_Comment := Scan_Ptr;
 
                --  Loop to scan comment (this loop runs more than once only if
                --  a horizontal tab or other non-graphic character is scanned)
@@ -1449,9 +1455,18 @@ package body Scng is
 
                end loop;
 
-               --  Note that we do NOT execute a return here, instead we fall
-               --  through to reexecute the scan loop to look for a token.
-
+               --  Note that, except when comments are tokens, we do NOT
+               --  execute a return here, instead we fall through to reexecute
+               --  the scan loop to look for a token.
+
+               if Comment_Is_Token then
+                  Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
+                  Name_Buffer (1 .. Name_Len) :=
+                    String (Source (Start_Of_Comment .. Scan_Ptr - 1));
+                  Comment_Id := Name_Find;
+                  Token := Tok_Comment;
+                  return;
+               end if;
             end if;
          end Minus_Case;
 
@@ -2066,6 +2081,14 @@ package body Scng is
             return;
          end if;
    end Scan;
+   --------------------------
+   -- Set_Comment_As_Token --
+   --------------------------
+
+   procedure Set_Comment_As_Token (Value : Boolean) is
+   begin
+      Comment_Is_Token := Value;
+   end Set_Comment_As_Token;
 
    ------------------------------
    -- Set_End_Of_Line_As_Token --
Index: scng.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/scng.ads,v
retrieving revision 1.1
diff -u -p -r1.1 scng.ads
--- scng.ads	21 Oct 2003 13:42:18 -0000	1.1
+++ scng.ads	8 Dec 2003 10:31:51 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -90,6 +90,10 @@ package Scng is
    procedure Set_End_Of_Line_As_Token (Value : Boolean);
    --  Indicate if End_Of_Line is a token or not.
    --  By default, End_Of_Line is not a token.
+
+   procedure Set_Comment_As_Token (Value : Boolean);
+   --  Indicate if a comment is a token or not.
+   --  By default, a comment is not a token.
 
    function Set_Start_Column return Column_Number;
    --  This routine is called with Scan_Ptr pointing to the first character
Index: sem_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_aggr.adb,v
retrieving revision 1.11
diff -u -p -r1.11 sem_aggr.adb
--- sem_aggr.adb	20 Nov 2003 09:54:00 -0000	1.11
+++ sem_aggr.adb	8 Dec 2003 10:31:51 -0000
@@ -29,6 +29,7 @@ with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
+with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Itypes;   use Itypes;
@@ -334,7 +335,7 @@ package body Sem_Aggr is
    --
    --    Typ is the context type in which N occurs.
    --
-   --  This routine creates an implicit array subtype whose bouds are
+   --  This routine creates an implicit array subtype whose bounds are
    --  those defined by the aggregate. When this routine is invoked
    --  Resolve_Array_Aggregate has already processed aggregate N. Thus the
    --  Aggregate_Bounds of each sub-aggregate, is an N_Range node giving the
@@ -962,6 +963,8 @@ package body Sem_Aggr is
             --  formal parameter. Consequently we also need to test for
             --  N_Procedure_Call_Statement or N_Function_Call.
 
+            Set_Etype (N, Aggr_Typ);  --  may be overridden later on.
+
             if Is_Constrained (Typ) and then
               (Pkind = N_Assignment_Statement      or else
                Pkind = N_Parameter_Association     or else
@@ -1641,9 +1644,27 @@ package body Sem_Aggr is
                   end if;
                end loop;
 
-               if not
-                 Resolve_Aggr_Expr
-                   (Expression (Assoc), Single_Elmt => Single_Choice)
+               --  Ada0Y (AI-287): In case of default initialized component
+               --  we delay the resolution to the expansion phase
+
+               if Box_Present (Assoc) then
+
+                  --  Ada0Y (AI-287): In case of default initialization of a
+                  --  component the expander will generate calls to the
+                  --  corresponding initialization subprogram.
+
+                  if Present (Base_Init_Proc (Etype (Component_Typ)))
+                    or else Has_Task (Base_Type (Component_Typ))
+                  then
+                     null;
+                  else
+                     Error_Msg_N
+                       ("(Ada 0Y): no value supplied for this component",
+                        Assoc);
+                  end if;
+
+               elsif not Resolve_Aggr_Expr (Expression (Assoc),
+                                            Single_Elmt => Single_Choice)
                then
                   return Failure;
                end if;
@@ -1764,8 +1785,26 @@ package body Sem_Aggr is
 
          if Others_Present then
             Assoc := Last (Component_Associations (N));
-            if not Resolve_Aggr_Expr (Expression (Assoc),
-                                      Single_Elmt => False)
+
+            --  Ada0Y (AI-287): In case of default initialized component
+            --  we delay the resolution to the expansion phase.
+
+            if Box_Present (Assoc) then
+
+               --  Ada0Y (AI-287): In case of default initialization of a
+               --  component the expander will generate calls to the
+               --  corresponding initialization subprogram.
+
+               if Present (Base_Init_Proc (Etype (Component_Typ))) then
+                  null;
+               else
+                  Error_Msg_N
+                    ("(Ada 0Y): no value supplied for these components",
+                     Assoc);
+               end if;
+
+            elsif not Resolve_Aggr_Expr (Expression (Assoc),
+                                         Single_Elmt => False)
             then
                return Failure;
             end if;
Index: sem_ch12.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch12.adb,v
retrieving revision 1.28
diff -u -p -r1.28 sem_ch12.adb
--- sem_ch12.adb	20 Nov 2003 09:54:01 -0000	1.28
+++ sem_ch12.adb	8 Dec 2003 10:31:52 -0000
@@ -1466,7 +1466,10 @@ package body Sem_Ch12 is
       end if;
 
       if K = E_Generic_In_Parameter then
-         if Is_Limited_Type (T) then
+
+         --  Ada0Y (AI-287): Limited aggregates allowed in generic formals
+
+         if not Extensions_Allowed and then Is_Limited_Type (T) then
             Error_Msg_N
               ("generic formal of mode IN must not be of limited type", N);
             Explain_Limited_Type (T, N);
Index: sem_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch3.adb,v
retrieving revision 1.24
diff -u -p -r1.24 sem_ch3.adb
--- sem_ch3.adb	27 Nov 2003 11:40:45 -0000	1.24
+++ sem_ch3.adb	8 Dec 2003 10:31:53 -0000
@@ -6246,6 +6246,7 @@ package body Sem_Ch3 is
       if (Is_Limited_Type (T)
            or else Is_Limited_Composite (T))
         and then not In_Instance
+        and then not In_Inlined_Body
       then
          --  Ada0Y (AI-287): Relax the strictness of the front-end in case of
          --  limited aggregates and extension aggregates.
@@ -8438,18 +8439,6 @@ package body Sem_Ch3 is
 
       Init_Size_Align (Implicit_Base);
 
-      --  Complete entity for first subtype
-
-      Set_Ekind          (T, E_Decimal_Fixed_Point_Subtype);
-      Set_Etype          (T, Implicit_Base);
-      Set_Size_Info      (T, Implicit_Base);
-      Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
-      Set_Digits_Value   (T, Digs_Val);
-      Set_Delta_Value    (T, Delta_Val);
-      Set_Small_Value    (T, Delta_Val);
-      Set_Scale_Value    (T, Scale_Val);
-      Set_Is_Constrained (T);
-
       --  If there are bounds given in the declaration use them as the
       --  bounds of the first named subtype.
 
@@ -8491,6 +8480,18 @@ package body Sem_Ch3 is
       else
          Set_Fixed_Range (T, Loc, -Bound_Val, Bound_Val);
       end if;
+
+      --  Complete entity for first subtype
+
+      Set_Ekind          (T, E_Decimal_Fixed_Point_Subtype);
+      Set_Etype          (T, Implicit_Base);
+      Set_Size_Info      (T, Implicit_Base);
+      Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
+      Set_Digits_Value   (T, Digs_Val);
+      Set_Delta_Value    (T, Delta_Val);
+      Set_Small_Value    (T, Delta_Val);
+      Set_Scale_Value    (T, Scale_Val);
+      Set_Is_Constrained (T);
 
    end Decimal_Fixed_Point_Type_Declaration;
 
Index: sem_util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_util.adb,v
retrieving revision 1.15
diff -u -p -r1.15 sem_util.adb
--- sem_util.adb	20 Nov 2003 09:54:01 -0000	1.15
+++ sem_util.adb	8 Dec 2003 10:31:53 -0000
@@ -6371,6 +6371,9 @@ package body Sem_Util is
             Error_Msg_N (
               "operator of the type is not directly visible!", Expr);
 
+         elsif Ekind (Found_Type) = E_Void then
+            Error_Msg_NE ("found premature usage of}!", Expr, Found_Type);
+
          else
             Error_Msg_NE ("found}!", Expr, Found_Type);
          end if;
Index: sinput-p.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sinput-p.adb,v
retrieving revision 1.5
diff -u -p -r1.5 sinput-p.adb
--- sinput-p.adb	21 Oct 2003 13:42:22 -0000	1.5
+++ sinput-p.adb	8 Dec 2003 10:31:53 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -24,7 +24,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Prj;         use Prj;
 with Prj.Err;
 with Sinput.C;
 
@@ -97,7 +96,7 @@ package body Sinput.P is
         or else Token = Tok_Private
         or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
       loop
-         Scan;
+         Prj.Err.Scanner.Scan;
       end loop;
 
       return Token = Tok_Separate;
Index: targparm.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/targparm.ads,v
retrieving revision 1.6
diff -u -p -r1.6 targparm.ads
--- targparm.ads	21 Oct 2003 13:42:22 -0000	1.6
+++ targparm.ads	8 Dec 2003 10:31:53 -0000
@@ -322,12 +322,6 @@ package Targparm is
    --
    --    The variable __gnat_exit_status is generated within the binder file
    --    instead of being imported from the run-time library.
-   --
-   --    No -Ldir switches are added for the linker step
-   --
-   --    No standard switches are added after user file entries to the
-   --    linker line. All such switches must be explicit. In other words
-   --    the option -nostdlib is implicit with a configurable run-time.
 
    Suppress_Standard_Library_On_Target : Boolean;
    --  If this flag is True, then the standard library is not included by
Index: Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.58
diff -u -p -r1.58 Makefile.in
--- Makefile.in	5 Dec 2003 10:24:05 -0000	1.58
+++ Makefile.in	8 Dec 2003 10:31:53 -0000
@@ -1843,6 +1843,8 @@ rts-zfp: force
 	-$(GNATMAKE) -Prts-zfp/zfp.gpr --GCC="../../../xgcc -B../../../"
 	$(RM) rts-zfp/adalib/*.o
 	$(CHMOD) a-wx rts-zfp/adalib/*.ali
+	$(AR) r rts-zfp/adalib/libgnat.a
+	$(CHMOD) a-wx rts-zfp/adalib/libgnat.a
 
 rts-none: force
 	$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
@@ -1861,6 +1863,8 @@ rts-ravenscar: force
 	-$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
 	   --GCC="../../../xgcc -B../../../"
 	$(CHMOD) a-wx rts-ravenscar/adalib/*.ali
+	$(AR) r rts-ravenscar/adalib/libgnat.a
+	$(CHMOD) a-wx rts-ravenscar/adalib/libgnat.a
 
 # Warning: this target assumes that LIBRARY_VERSION has been set correctly.
 gnatlib-shared-default:
Index: Make-lang.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Make-lang.in,v
retrieving revision 1.61
diff -u -p -r1.61 Make-lang.in
--- Make-lang.in	5 Dec 2003 10:24:04 -0000	1.61
+++ Make-lang.in	8 Dec 2003 10:31:53 -0000
@@ -915,8 +915,8 @@ ada.distclean:
 	-$(RM) ada/tools/*
 	-$(RMDIR) ada/tools
 ada.maintainer-clean:
-	-$(RM) ada/a-sinfo.h
-	-$(RM) ada/a-einfo.h
+	-$(RM) ada/sinfo.h
+	-$(RM) ada/einfo.h
 	-$(RM) ada/nmake.adb
 	-$(RM) ada/nmake.ads
 	-$(RM) ada/treeprs.ads
@@ -1213,6 +1213,11 @@ ada/a-charac.o : ada/ada.ads ada/a-chara
 ada/a-chlat1.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
    ada/system.ads 
 
+ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
+   ada/a-elchha.adb ada/system.ads ada/s-secsta.ads ada/s-soflin.ads \
+   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+   ada/s-traent.ads ada/unchconv.ads 
+
 ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
    ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
    ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads ada/a-uncdea.ads \
@@ -1525,26 +1530,26 @@ ada/exp_aggr.o : ada/ada.ads ada/a-excep
    ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
    ada/exp_aggr.ads ada/exp_aggr.adb ada/exp_ch11.ads ada/exp_ch2.ads \
-   ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
-   ada/exp_util.adb ada/expander.ads ada/fname.ads ada/freeze.ads \
-   ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
-   ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
-   ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
-   ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
-   ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
-   ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_cat.ads \
-   ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb \
-   ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
-   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
-   ada/sprint.ads ada/stand.ads ada/stringt.ads ada/system.ads \
-   ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
-   ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
-   ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
-   ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
-   ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/validsw.ads 
+   ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_tss.ads \
+   ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \
+   ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
+   ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
+   ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
+   ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
+   ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+   ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem.ads \
+   ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads \
+   ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
+   ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+   ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
+   ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
+   ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
+   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+   ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+   ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
 
 ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
@@ -1679,13 +1684,13 @@ ada/exp_ch3.o : ada/ada.ads ada/a-except
    ada/sem_intr.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb \
    ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
-   ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
-   ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
-   ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
-   ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
-   ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+   ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
+   ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
+   ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
 
 ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \



More information about the Gcc-patches mailing list