[multiple changes]

2009-05-06  Gary Dismukes  <dismukes@adacore.com>

	* sem_aggr.adb: Fix typo.

2009-05-06  Thomas Quinot  <quinot@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): For a controlled object
	declaration, do not adjust if the declaration is to be rewritten into
	a renaming.

2009-05-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Type): Reject the use of a task type in its own
	discriminant part.

2009-05-06  Bob Duff  <duff@adacore.com>

	* s-fileio.adb (File_IO_Clean_Up_Type): Make this type limited, since
	otherwise the compiler would be allowed to optimize away the cleanup
	code.

From-SVN: r147163

gcc/ada/ChangeLog

 2009-05-06  Gary Dismukes  <dismukes@adacore.com>
 
+	* sem_aggr.adb: Fix typo.
+
+2009-05-06  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): For a controlled object
+	declaration, do not adjust if the declaration is to be rewritten into
+	a renaming.
+
+2009-05-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Find_Type): Reject the use of a task type in its own
+	discriminant part.
+
+2009-05-06  Bob Duff  <duff@adacore.com>
+
+	* s-fileio.adb (File_IO_Clean_Up_Type): Make this type limited, since
+	otherwise the compiler would be allowed to optimize away the cleanup
+	code.
+
+2009-05-06  Gary Dismukes  <dismukes@adacore.com>
+
 	* gnat_ugn.texi: Fix typo.
 
 2009-05-06  Thomas Quinot  <quinot@adacore.com>

gcc/ada/exp_ch3.adb

@@ -1888,8 +1888,8 @@ package body Exp_Ch3 is
          end if;
 
          if Needs_Finalization (Typ)
-         and then not (Kind = N_Aggregate or else Kind = N_Extension_Aggregate)
-         and then not Is_Inherently_Limited_Type (Typ)
+           and then not (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate))
+           and then not Is_Inherently_Limited_Type (Typ)
          then
             Append_List_To (Res,
               Make_Adjust_Call (
@@ -4185,9 +4185,28 @@ package body Exp_Ch3 is
       --  which case the init proc call must be inserted only after the bodies
       --  of the shared variable procedures have been seen.
 
+      function Rewrite_As_Renaming return Boolean;
+      --  Indicate whether to rewrite a declaration with initialization into an
+      --  object renaming declaration (see below).
+
+      -------------------------
+      -- Rewrite_As_Renaming --
+      -------------------------
+
+      function Rewrite_As_Renaming return Boolean is
+      begin
+         return not Aliased_Present (N)
+           and then Is_Entity_Name (Expr_Q)
+           and then Ekind (Entity (Expr_Q)) = E_Variable
+           and then OK_To_Rename (Entity (Expr_Q))
+           and then Is_Entity_Name (Object_Definition (N));
+      end Rewrite_As_Renaming;
+
+   --  Start of processing for Expand_N_Object_Declaration
+
    begin
-      --  Don't do anything for deferred constants. All proper actions will
-      --  be expanded during the full declaration.
+      --  Don't do anything for deferred constants. All proper actions will be
+      --  expanded during the full declaration.
 
       if No (Expr) and Constant_Present (N) then
          return;
@@ -4603,10 +4622,13 @@ package body Exp_Ch3 is
             --  where the object was initialized by a call to a function whose
             --  result is built in place, since no copy occurred. (Eventually
             --  we plan to support in-place function results for some cases
-            --  of nonlimited types. ???)
+            --  of nonlimited types. ???) Similarly, no adjustment is required
+            --  if we are going to rewrite the object declaration into a
+            --  renaming declaration.
 
             if Needs_Finalization (Typ)
               and then not Is_Inherently_Limited_Type (Typ)
+              and then not Rewrite_As_Renaming
             then
                Insert_Actions_After (Init_After,
                  Make_Adjust_Call (
@@ -4750,14 +4772,11 @@ package body Exp_Ch3 is
          --     X : typ renames expr
 
          --  provided that X is not aliased. The aliased case has to be
-         --  excluded in general because expr will not be aliased in general.
+         --  excluded in general because Expr will not be aliased in general.
+         --  We also exclude controlled types because X and Expr may need to
+         --  be attached to distinct finalization lists.
 
-         if not Aliased_Present (N)
-           and then Is_Entity_Name (Expr_Q)
-           and then Ekind (Entity (Expr_Q)) = E_Variable
-           and then OK_To_Rename (Entity (Expr_Q))
-           and then Is_Entity_Name (Object_Definition (N))
-         then
+         if Rewrite_As_Renaming then
             Rewrite (N,
               Make_Object_Renaming_Declaration (Loc,
                 Defining_Identifier => Defining_Identifier (N),

gcc/ada/s-fileio.adb

@@ -73,12 +73,12 @@ package body System.File_IO is
    --  Points to list of names of temporary files. Note that this global
    --  variable must be properly protected to provide thread safety.
 
-   type File_IO_Clean_Up_Type is new Controlled with null record;
+   type File_IO_Clean_Up_Type is new Limited_Controlled with null record;
    --  The closing of all open files and deletion of temporary files is an
-   --  action which takes place at the end of execution of the main program.
-   --  This action can be implemented using a library level object which
-   --  gets finalized at the end of the main program execution. The above is
-   --  a controlled type introduced for this purpose.
+   --  action that takes place at the end of execution of the main program.
+   --  This action is implemented using a library level object which gets
+   --  finalized at the end of program execution. Note that the type should be
+   --  limited, in order to avoid unwanted optimizations.
 
    procedure Finalize (V : in out File_IO_Clean_Up_Type);
    --  This is the finalize operation that is used to do the cleanup

gcc/ada/sem_aggr.adb

@@ -3076,10 +3076,14 @@ package body Sem_Aggr is
             --  of all ancestors, starting with the root.
 
             if Nkind (N) = N_Extension_Aggregate then
+
+               --  If the ancestor part is a C++ constructor we must handle
+               --  here that it is a function returning a class-wide type
+
                if Is_CPP_Constructor_Call (Ancestor_Part (N)) then
                   pragma Assert
                     (Is_Class_Wide_Type (Etype (Ancestor_Part (N))));
-                  Root_Typ := Base_Type (Etype (Etype (Ancestor_Part (N))));
+                  Root_Typ := Root_Type (Etype (Ancestor_Part (N)));
                else
                   Root_Typ := Base_Type (Etype (Ancestor_Part (N)));
                end if;
@@ -3462,7 +3466,7 @@ package body Sem_Aggr is
                                    (Inner_Comp, New_Aggr,
                                      Component_Associations (Aggr));
 
-                                 --  Collect disciminant values and recurse
+                                 --  Collect discriminant values and recurse
 
                                  Add_Discriminant_Values
                                    (New_Aggr, Assoc_List);

gcc/ada/sem_ch8.adb

@@ -5722,14 +5722,25 @@ package body Sem_Ch8 is
                if Ekind (Base_Type (T_Name)) = E_Task_Type then
 
                   --  In Ada 2005, a task name can be used in an access
-                  --  definition within its own body.
+                  --  definition within its own body. It cannot be used
+                  --  in the discriminant part of the task declaration,
+                  --  nor anywhere else in the declaration because entries
+                  --  cannot have access parameters.
 
                   if Ada_Version >= Ada_05
                     and then Nkind (Parent (N)) = N_Access_Definition
                   then
                      Set_Entity (N, T_Name);
                      Set_Etype  (N, T_Name);
-                     return;
+
+                     if Has_Completion (T_Name) then
+                        return;
+
+                     else
+                        Error_Msg_N
+                          ("task type cannot be used as type mark " &
+                           "within its own declaration", N);
+                     end if;
 
                   else
                      Error_Msg_N