[multiple changes]

2011-08-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: (Check_Private_Overriding): better error message,
	suggested by AI95-0068.

2011-08-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Find_Last_Init): Use Next_Suitable_Statement to retrieve
	the two potential initialization calls. This accounts for any
	access-before-elaboration checks which may precede the initialization
	calls.
	(Next_Suitable_Statement): New routine. Returns the next real statement
	after the input node while skipping generated checks.
	* sem_elab.adb (Check_A_Call): New formal parameter In_Init_Proc along
	with comment on usage.
	Do not generate Elaborate_All when the trigger is a finalization call
	coming from a type init proc.
	(Check_Elab_Call): Propagate the initialization procedure context to
	subsequent calls to Check_A_Call.
	(Check_Internal_Call_Continue): Propagate the initialization procedure
	context to subsequent calls to Check_Elab_Call.
	(Is_Finalization_Procedure): New routine. Returns True if the input
	entity denotes a [Deep_]Finalize routine.
	* sem_elab.ads (Check_Elab_Call): New formal parameter In_Init_Proc
	along with comment on usage.

2011-08-05  Vadim Godunko  <godunko@adacore.com>

	* s-atocou.ads: Add list of supported platforms.

2011-08-05  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb, restrict.adb: Correct style for or'ing Boolean variables

	* opt.ads (Disable_ALI_File): new Boolean flag
	* lib-writ.adb (Write_ALI): when Disable_ALI_File is set, do nothing

2011-08-05  Ed Falis  <falis@adacore.com>

	* env.c (__gnat_environ): Fix includes for RTPs and VTHREADS so that
	environ is properly defined.

2011-08-05  Vincent Celier  <celier@adacore.com>

	* make.adb (Compilation_Phase): Exit immediately when all objects have
	been found up to date, to avoid multiple exit messages.
	* prj-nmsc.adb (Add_Source): Allow duplicate source file names in the
	same project for languages with no compiler.
	* gnat_ugn.texi: Document compiler switch -gnateI and gnatmake switch
	-eI.

From-SVN: r177434

1 files changed, 68 insertions, 33 deletions

diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index f96fbb9..a5130c1 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -177,7 +177,8 @@ package body Sem_Elab is
       E                 : Entity_Id;
       Outer_Scope       : Entity_Id;
       Inter_Unit_Only   : Boolean;
-      Generate_Warnings : Boolean := True);
+      Generate_Warnings : Boolean := True;
+      In_Init_Proc      : Boolean := False);
    --  This is the internal recursive routine that is called to check for a
    --  possible elaboration error. The argument N is a subprogram call or
    --  generic instantiation to be checked, and E is the entity of the called
@@ -186,7 +187,8 @@ package body Sem_Elab is
    --  call is only to be checked in the case where it is to another unit (and
    --  skipped if within a unit). Generate_Warnings is set to False to suppress
    --  warning messages about missing pragma Elaborate_All's. These messages
-   --  are not wanted for inner calls in the dynamic model.
+   --  are not wanted for inner calls in the dynamic model. Flag In_Init_Proc
+   --  should be set whenever the current context is a type init proc.
 
    procedure Check_Bad_Instantiation (N : Node_Id);
    --  N is a node for an instantiation (if called with any other node kind,
@@ -229,29 +231,6 @@ package body Sem_Elab is
    --  Check_Internal_Call. Outer_Scope is the outer level scope for the
    --  original call.
 
-   procedure Set_Elaboration_Constraint
-    (Call : Node_Id;
-     Subp : Entity_Id;
-     Scop : Entity_Id);
-   --  The current unit U may depend semantically on some unit P which is not
-   --  in the current context. If there is an elaboration call that reaches P,
-   --  we need to indicate that P requires an Elaborate_All, but this is not
-   --  effective in U's ali file, if there is no with_clause for P. In this
-   --  case we add the Elaborate_All on the unit Q that directly or indirectly
-   --  makes P available. This can happen in two cases:
-   --
-   --    a) Q declares a subtype of a type declared in P, and the call is an
-   --    initialization call for an object of that subtype.
-   --
-   --    b) Q declares an object of some tagged type whose root type is
-   --    declared in P, and the initialization call uses object notation on
-   --    that object to reach a primitive operation or a classwide operation
-   --    declared in P.
-   --
-   --  If P appears in the context of U, the current processing is correct.
-   --  Otherwise we must identify these two cases to retrieve Q and place the
-   --  Elaborate_All_Desirable on it.
-
    function Has_Generic_Body (N : Node_Id) return Boolean;
    --  N is a generic package instantiation node, and this routine determines
    --  if this package spec does in fact have a generic body. If so, then
@@ -273,6 +252,9 @@ package body Sem_Elab is
    --  or instantiation node for which the check code is required. C is the
    --  test whose failure triggers the raise.
 
+   function Is_Finalization_Procedure (Id : Entity_Id) return Boolean;
+   --  Determine whether entity Id denotes a [Deep_]Finalize procedure
+
    procedure Output_Calls (N : Node_Id);
    --  Outputs chain of calls stored in the Elab_Call table. The caller has
    --  already generated the main warning message, so the warnings generated
@@ -287,6 +269,29 @@ package body Sem_Elab is
    --  On entry C_Scope is set to some scope. On return, C_Scope is reset
    --  to be the enclosing compilation unit of this scope.
 
+   procedure Set_Elaboration_Constraint
+    (Call : Node_Id;
+     Subp : Entity_Id;
+     Scop : Entity_Id);
+   --  The current unit U may depend semantically on some unit P which is not
+   --  in the current context. If there is an elaboration call that reaches P,
+   --  we need to indicate that P requires an Elaborate_All, but this is not
+   --  effective in U's ali file, if there is no with_clause for P. In this
+   --  case we add the Elaborate_All on the unit Q that directly or indirectly
+   --  makes P available. This can happen in two cases:
+   --
+   --    a) Q declares a subtype of a type declared in P, and the call is an
+   --    initialization call for an object of that subtype.
+   --
+   --    b) Q declares an object of some tagged type whose root type is
+   --    declared in P, and the initialization call uses object notation on
+   --    that object to reach a primitive operation or a classwide operation
+   --    declared in P.
+   --
+   --  If P appears in the context of U, the current processing is correct.
+   --  Otherwise we must identify these two cases to retrieve Q and place the
+   --  Elaborate_All_Desirable on it.
+
    function Spec_Entity (E : Entity_Id) return Entity_Id;
    --  Given a compilation unit entity, if it is a spec entity, it is returned
    --  unchanged. If it is a body entity, then the spec for the corresponding
@@ -472,7 +477,8 @@ package body Sem_Elab is
       E                 : Entity_Id;
       Outer_Scope       : Entity_Id;
       Inter_Unit_Only   : Boolean;
-      Generate_Warnings : Boolean := True)
+      Generate_Warnings : Boolean := True;
+      In_Init_Proc      : Boolean := False)
    is
       Loc  : constant Source_Ptr := Sloc (N);
       Ent  : Entity_Id;
@@ -965,6 +971,14 @@ package body Sem_Elab is
             then
                null;
 
+            --  Do not generate an Elaborate_All for finalization routines
+            --  which perform partial clean up as part of initialization.
+
+            elsif In_Init_Proc
+              and then Is_Finalization_Procedure (Ent)
+            then
+               null;
+
             --  Here we need to generate an implicit elaborate all
 
             else
@@ -1104,8 +1118,9 @@ package body Sem_Elab is
    ---------------------
 
    procedure Check_Elab_Call
-     (N           : Node_Id;
-      Outer_Scope : Entity_Id := Empty)
+     (N            : Node_Id;
+      Outer_Scope  : Entity_Id := Empty;
+      In_Init_Proc : Boolean := False)
    is
       Ent : Entity_Id;
       P   : Node_Id;
@@ -1414,14 +1429,19 @@ package body Sem_Elab is
 
       C_Scope := Current_Scope;
 
-      --  If not outer level call, then we follow it if it is within
-      --  the original scope of the outer call.
+      --  If not outer level call, then we follow it if it is within the
+      --  original scope of the outer call.
 
       if Present (Outer_Scope)
         and then Within (Scope (Ent), Outer_Scope)
       then
          Set_C_Scope;
-         Check_A_Call (N, Ent, Outer_Scope, Inter_Unit_Only => False);
+         Check_A_Call
+           (N               => N,
+            E               => Ent,
+            Outer_Scope     => Outer_Scope,
+            Inter_Unit_Only => False,
+            In_Init_Proc    => In_Init_Proc);
 
       elsif Elaboration_Checks_Suppressed (Current_Scope) then
          null;
@@ -1446,7 +1466,7 @@ package body Sem_Elab is
            (N,
             Ent,
             Standard_Standard,
-            Inter_Unit_Only => True,
+            Inter_Unit_Only   => True,
             Generate_Warnings => False);
 
       --  Otherwise nothing to do
@@ -1978,7 +1998,7 @@ package body Sem_Elab is
          --  arguments that are assignments (OUT or IN OUT mode formals).
 
          elsif Nkind (N) = N_Procedure_Call_Statement then
-            Check_Elab_Call (N, Outer_Scope);
+            Check_Elab_Call (N, Outer_Scope, In_Init_Proc => Is_Init_Proc (E));
 
             Actual := First_Actual (N);
             while Present (Actual) loop
@@ -2912,6 +2932,21 @@ package body Sem_Elab is
       end if;
    end Insert_Elab_Check;
 
+   -------------------------------
+   -- Is_Finalization_Procedure --
+   -------------------------------
+
+   function Is_Finalization_Procedure (Id : Entity_Id) return Boolean is
+   begin
+      return
+        Ekind (Id) = E_Procedure
+          and then
+            (Chars (Id) = Name_Finalize
+               or else Is_TSS (Id, TSS_Deep_Finalize))
+          and then Present (First_Formal (Id))
+          and then Needs_Finalization (Etype (First_Formal (Id)));
+   end Is_Finalization_Procedure;
+
    ------------------
    -- Output_Calls --
    ------------------