[multiple changes]

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

	* einfo.adb (Write_Field28_Name): Update the choices for
	Extra_Formals.
	* einfo.ads: Update the use of Extra_Formals in various entities.
	* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code
	reformatting. Handle the case where the function call returns
	an incomplete type coming from a limited with context. Generate
	a reference to the _master when the master id is associated
	with an access type.
	(Is_Build_In_Place_Function_Call): Code
	reformatting. The Alfa mode case must appear first since otherwise
	we will carry out the function name retrieval regardless of the
	compilation mode.
	(Make_Build_In_Place_Call_In_Allocator): Code
	reformatting. Handle the case where the function call returns
	an incomplete type coming from a limited with context. Remove
	the reference creation when adding the task-related actuals,
	this is now done in Add_Task_Actuals_To_Build_In_Place_Call.
	* exp_ch7.adb (Make_Set_Finalize_Address_Call): Remove local
	variable Call. Remove the useless wrapping of Set_Finalize_Address
	when the finalization master is a build-in-place extra formal. The
	whole mechanism of controlled allocation in a build-in-place
	context is already protected by an if statement.
	* sem_aux.adb (Is_Immutably_Limited_Type): Handle the case
	where the type might be related to a function which returns an
	incomplete type coming from a limited with.
	* sem_ch6.adb (Create_Extra_Formals): Comment
	reformatting. Handle the case where the function returns an
	incomplete type coming from a limited with context.

2011-09-05  Johannes Kanig  <kanig@adacore.com>

	* lib-xref-alfa.adb (Is_Alfa_Reference): Improve test for constant
	objects and rewrite case statement as /if/elsif/endif.

2011-09-05  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb, sem_ch4.adb: Minor reformatting.

From-SVN: r178537

gcc/ada/einfo.adb

@@ -8686,9 +8686,12 @@ package body Einfo is
    procedure Write_Field28_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when E_Procedure                                  |
+         when E_Entry                                      |
+              E_Entry_Family                               |
               E_Function                                   |
-              E_Entry                                      =>
+              E_Procedure                                  |
+              E_Subprogram_Body                            |
+              E_Subprogram_Type                            =>
             Write_Str ("Extra_Formals");
 
          when E_Record_Type =>

gcc/ada/einfo.ads

@@ -5137,6 +5137,7 @@ package Einfo is
    --    Protection_Object                   (Node23)   (protected kind)
    --    Contract                            (Node24)   (for entry only)
    --    PPC_Wrapper                         (Node25)
+   --    Extra_Formals                       (Node28)
    --    Default_Expressions_Processed       (Flag108)
    --    Entry_Accepted                      (Flag152)
    --    Is_AST_Entry                        (Flag132)  (for entry only)
@@ -5670,10 +5671,12 @@ package Einfo is
    --    Corresponding_Protected_Entry       (Node18)
    --    Last_Entity                         (Node20)
    --    Scope_Depth_Value                   (Uint22)
+   --    Extra_Formals                       (Node28)
    --    Scope_Depth                         (synth)
 
    --  E_Subprogram_Type
    --    Directly_Designated_Type            (Node20)
+   --    Extra_Formals                       (Node28)
    --    First_Formal                        (synth)
    --    First_Formal_With_Extras            (synth)
    --    Last_Formal                         (synth)

gcc/ada/exp_ch6.adb

@@ -469,7 +469,7 @@ package body Exp_Ch6 is
    begin
       --  No such extra parameters are needed if there are no tasks
 
-      if not Has_Task (Etype (Function_Id)) then
+      if not Has_Task (Available_View (Etype (Function_Id))) then
          return;
       end if;
 
@@ -477,6 +477,12 @@ package body Exp_Ch6 is
 
       if Restriction_Active (No_Task_Hierarchy) then
          Actual := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc);
+
+      --  In the case where we use the master associated with an access type,
+      --  the actual is an entity and requires an explicit reference.
+
+      elsif Nkind (Actual) = N_Defining_Identifier then
+         Actual := New_Reference_To (Actual, Loc);
       end if;
 
       --  The master
@@ -493,8 +499,7 @@ package body Exp_Ch6 is
          --  Build the parameter association for the new actual and add it to
          --  the end of the function's actuals.
 
-         Add_Extra_Actual_To_Call
-           (Function_Call, Master_Formal, Actual);
+         Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual);
       end;
 
       --  The activation chain
@@ -506,8 +511,8 @@ package body Exp_Ch6 is
       begin
          --  Locate implicit activation chain parameter in the called function
 
-         Activation_Chain_Formal := Build_In_Place_Formal
-           (Function_Id, BIP_Activation_Chain);
+         Activation_Chain_Formal :=
+           Build_In_Place_Formal (Function_Id, BIP_Activation_Chain);
 
          --  Create the actual which is a pointer to the current activation
          --  chain
@@ -6814,8 +6819,8 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind_In
-           (Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion)
+      if Nkind_In (Exp_Node, N_Qualified_Expression,
+                             N_Unchecked_Type_Conversion)
       then
          Exp_Node := Expression (N);
       end if;
@@ -6824,19 +6829,22 @@ package body Exp_Ch6 is
          return False;
 
       else
-         if Is_Entity_Name (Name (Exp_Node)) then
+         --  In Alfa mode, build-in-place calls are not expanded, so that we
+         --  may end up with a call that is neither resolved to an entity, nor
+         --  an indirect call.
+
+         if Alfa_Mode then
+            return False;
+
+         elsif Is_Entity_Name (Name (Exp_Node)) then
             Function_Id := Entity (Name (Exp_Node));
 
+         --  In the case of an explicitly dereferenced call, use the subprogram
+         --  type generated for the dereference.
+
          elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
             Function_Id := Etype (Name (Exp_Node));
 
-         --  In Alfa mode, protected subprogram calls are not expanded, so that
-         --  we may end up with a call that is neither resolved to an entity,
-         --  nor an indirect call.
-
-         elsif Alfa_Mode then
-            return False;
-
          else
             raise Program_Error;
          end if;
@@ -7092,11 +7100,11 @@ package body Exp_Ch6 is
      (Allocator     : Node_Id;
       Function_Call : Node_Id)
    is
+      Acc_Type          : constant Entity_Id := Etype (Allocator);
       Loc               : Source_Ptr;
       Func_Call         : Node_Id := Function_Call;
       Function_Id       : Entity_Id;
       Result_Subt       : Entity_Id;
-      Acc_Type          : constant Entity_Id := Etype (Allocator);
       New_Allocator     : Node_Id;
       Return_Obj_Access : Entity_Id;
 
@@ -7135,7 +7143,7 @@ package body Exp_Ch6 is
          raise Program_Error;
       end if;
 
-      Result_Subt := Etype (Function_Id);
+      Result_Subt := Available_View (Etype (Function_Id));
 
       --  Check whether return type includes tasks. This may not have been done
       --  previously, if the type was a limited view.
@@ -7236,17 +7244,8 @@ package body Exp_Ch6 is
          Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Acc_Type);
 
-         --  If access type has a master entity, pass a reference to it
-
-         if Present (Master_Id (Acc_Type)) then
-            Add_Task_Actuals_To_Build_In_Place_Call
-              (Func_Call, Function_Id,
-               Master_Actual =>
-                 New_Occurrence_Of (Master_Id (Acc_Type), Loc));
-         else
-            Add_Task_Actuals_To_Build_In_Place_Call
-              (Func_Call, Function_Id, Empty);
-         end if;
+         Add_Task_Actuals_To_Build_In_Place_Call
+           (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
 
          --  The caller does not provide the return object in this case, so we
          --  have to pass null for the object access actual.

gcc/ada/exp_ch7.adb

@@ -7461,7 +7461,6 @@ package body Exp_Ch7 is
       Desig_Typ   : constant Entity_Id :=
                       Available_View (Designated_Type (Ptr_Typ));
       Fin_Mas_Id  : constant Entity_Id := Finalization_Master (Ptr_Typ);
-      Call        : Node_Id;
       Fin_Mas_Ref : Node_Id;
       Utyp        : Entity_Id;
 
@@ -7526,7 +7525,7 @@ package body Exp_Ch7 is
       --  Generate:
       --    Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
 
-      Call :=
+      return
         Make_Procedure_Call_Statement (Loc,
           Name                   =>
             New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
@@ -7536,25 +7535,6 @@ package body Exp_Ch7 is
               Prefix         =>
                 New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
               Attribute_Name => Name_Unrestricted_Access)));
-
-      --  In the case of build-in-place functions, protect the call to ensure
-      --  we have a master at run time. Generate:
-
-      --    if <Ptr_Typ>FM /= null then
-      --       <Call>;
-      --    end if;
-
-      if Is_Access_Type (Etype (Fin_Mas_Id)) then
-         Call :=
-           Make_If_Statement (Loc,
-             Condition       =>
-               Make_Op_Ne (Loc,
-                 Left_Opnd  => New_Reference_To (Fin_Mas_Id, Loc),
-                 Right_Opnd => Make_Null (Loc)),
-             Then_Statements => New_List (Call));
-      end if;
-
-      return Call;
    end Make_Set_Finalize_Address_Call;
 
    --------------------------

gcc/ada/lib-xref-alfa.adb

@@ -604,38 +604,36 @@ package body Alfa is
             Typ : Character) return Boolean
          is
          begin
-            --  The only references of interest on callable entities are calls.
-            --  On non-callable entities, the only references of interest are
-            --  reads and writes.
 
-            case Ekind (E) is
-               when Overloadable_Kind =>
-                  return Typ = 's';
+            if Ekind (E) in Overloadable_Kind then
 
-               --  References to IN parameters and constants are not
-               --  considered in Alfa section, as these will be translated
-               --  as constants in the intermediate language for formal
-               --  verification, and should therefore never appear in frame
-               --  conditions.
+               --  The only references of interest on callable entities are
+               --  calls.  On non-callable entities, the only references of
+               --  interest are reads and writes.
 
-               --  What about E_Loop_Parameter???
+               return Typ = 's';
+
+            elsif Is_Constant_Object (E) then
+
+               --  References to constant objects are not considered in Alfa
+               --  section, as these will be translated as constants in the
+               --  intermediate language for formal verification, and should
+               --  therefore never appear in frame conditions.
 
-               when E_In_Parameter | E_Constant =>
                   return False;
 
-               when others =>
+            elsif Present (Etype (E)) and then
+               Ekind (Etype (E)) in Concurrent_Kind then
 
-                  --  Objects of Task type or protected type are not Alfa
-                  --  references.
+               --  Objects of Task type or protected type are not Alfa
+               --  references.
 
-                  if Present (Etype (E))
-                    and then Ekind (Etype (E)) in Concurrent_Kind
-                  then
-                     return False;
-                  end if;
+               return False;
 
-                  return Typ = 'r' or else Typ = 'm';
-            end case;
+            else
+               return Typ = 'r' or else Typ = 'm';
+
+            end if;
          end Is_Alfa_Reference;
 
          -------------------

gcc/ada/sem_aux.adb

@@ -597,7 +597,7 @@ package body Sem_Aux is
    -------------------------------
 
    function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
-      Btype : constant Entity_Id := Base_Type (Ent);
+      Btype : constant Entity_Id := Available_View (Base_Type (Ent));
 
    begin
       if Is_Limited_Record (Btype) then
@@ -607,9 +607,8 @@ package body Sem_Aux is
         and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
       then
          return not In_Package_Body (Scope ((Btype)));
-      end if;
 
-      if Is_Private_Type (Btype) then
+      elsif Is_Private_Type (Btype) then
 
          --  AI05-0063: A type derived from a limited private formal type is
          --  not immutably limited in a generic body.

gcc/ada/sem_ch3.adb

@@ -15061,6 +15061,7 @@ package body Sem_Ch3 is
                Tag_Mismatch;
             end if;
          end if;
+
          if Present (Prev)
            and then Nkind (Parent (Prev)) = N_Incomplete_Type_Declaration
            and then Present (Premature_Use (Parent (Prev)))

gcc/ada/sem_ch4.adb

@@ -4322,7 +4322,7 @@ package body Sem_Ch4 is
             Error_Msg_Node_2 := First_Subtype (Prefix_Type);
             Error_Msg_NE ("no selector& for}", N, Sel);
 
-            --  If prefix is incomplete, add information
+            --  Add information in the case of an incomplete prefix
 
             if Is_Incomplete_Type (Type_To_Use) then
                declare
@@ -4340,6 +4340,10 @@ package body Sem_Ch4 is
                      if Nkind (Parent (Inc)) =
                                           N_Incomplete_Type_Declaration
                      then
+                        --  Record location of premature use in entity so that
+                        --  a continuation message is generated when the
+                        --  completion is seen.
+
                         Set_Premature_Use (Parent (Inc), N);
                      end if;
                   end if;

gcc/ada/sem_ch6.adb

@@ -6371,11 +6371,11 @@ package body Sem_Ch6 is
                     E, BIP_Formal_Suffix (BIP_Finalization_Master));
             end if;
 
-            --  If the result type contains tasks, we have two extra formals:
-            --  the master of the tasks to be created, and the caller's
-            --  activation chain.
+            --  When the result type contains tasks, add two extra formals: the
+            --  master of the tasks to be created, and the caller's activation
+            --  chain.
 
-            if Has_Task (Result_Subt) then
+            if Has_Task (Available_View (Result_Subt)) then
                Discard :=
                  Add_Extra_Formal
                    (E, RTE (RE_Master_Id),