Index: einfo.adb
===================================================================
--- einfo.adb	(revision 178565)
+++ einfo.adb	(working copy)
@@ -161,6 +161,7 @@
 
    --    Body_Entity                     Node19
    --    Corresponding_Discriminant      Node19
+   --    Extra_Accessibility_Of_Result   Node19
    --    Parent_Subtype                  Node19
    --    Related_Array_Object            Node19
    --    Size_Check_Code                 Node19
@@ -1043,6 +1044,12 @@
       return Node13 (Id);
    end Extra_Accessibility;
 
+   function Extra_Accessibility_Of_Result (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+      return Node19 (Id);
+   end Extra_Accessibility_Of_Result;
+
    function Extra_Constrained (Id : E) return E is
    begin
       pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
@@ -3519,6 +3526,12 @@
       Set_Node13 (Id, V);
    end Set_Extra_Accessibility;
 
+   procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+      Set_Node19 (Id, V);
+   end Set_Extra_Accessibility_Of_Result;
+
    procedure Set_Extra_Constrained (Id : E; V : E) is
    begin
       pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
@@ -8312,6 +8325,9 @@
          when Private_Kind                                 =>
             Write_Str ("Underlying_Full_View");
 
+         when E_Function | E_Operator | E_Subprogram_Type =>
+            Write_Str ("Extra_Accessibility_Of_Result");
+
          when others                                       =>
             Write_Str ("Field19??");
       end case;
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 178565)
+++ einfo.ads	(working copy)
@@ -1131,6 +1131,15 @@
 --       must be retrieved through the entity designed by this field instead of
 --       being computed.
 
+--    Extra_Accessibility_Of_Result (Node19)
+--       Present in (non-generic) Function, Operator, and Subprogram_Type
+--       entities if expansion is active. Normally Empty, but if a function is
+--       one for which "the accessibility level of the result ... determined
+--       by the point of call" (AI05-0234) is needed, then an extra formal of
+--       subtype Natural is created (see description of field Extra_Formal),
+--       and the Extra_Accessibility_Of_Result field of the function points to
+--       the entity for this extra formal.
+
 --    Extra_Constrained (Node23)
 --       Present in formal parameters in the non-generic case if expansion is
 --       active. Normally Empty, but if a parameter is one for which a dynamic
@@ -5235,6 +5244,7 @@
    --    First_Entity                        (Node17)
    --    Alias                               (Node18)   (non-generic case only)
    --    Renamed_Entity                      (Node18)   (generic case only)
+   --    Extra_Accessibility_Of_Result       (Node19)   (non-generic case only)
    --    Last_Entity                         (Node20)
    --    Interface_Name                      (Node21)
    --    Scope_Depth_Value                   (Uint22)
@@ -5389,6 +5399,7 @@
    --  E_Operator
    --    First_Entity                        (Node17)
    --    Alias                               (Node18)
+   --    Extra_Accessibility_Of_Result       (Node19)
    --    Last_Entity                         (Node20)
    --    Overridden_Operation                (Node26)
    --    Subprograms_For_Type                (Node29)
@@ -5680,6 +5691,7 @@
    --    Scope_Depth                         (synth)
 
    --  E_Subprogram_Type
+   --    Extra_Accessibility_Of_Result       (Node19)
    --    Directly_Designated_Type            (Node20)
    --    Extra_Formals                       (Node28)
    --    First_Formal                        (synth)
@@ -6068,6 +6080,7 @@
    function Esize                               (Id : E) return U;
    function Exception_Code                      (Id : E) return U;
    function Extra_Accessibility                 (Id : E) return E;
+   function Extra_Accessibility_Of_Result       (Id : E) return E;
    function Extra_Constrained                   (Id : E) return E;
    function Extra_Formal                        (Id : E) return E;
    function Extra_Formals                       (Id : E) return E;
@@ -6656,6 +6669,7 @@
    procedure Set_Esize                           (Id : E; V : U);
    procedure Set_Exception_Code                  (Id : E; V : U);
    procedure Set_Extra_Accessibility             (Id : E; V : E);
+   procedure Set_Extra_Accessibility_Of_Result   (Id : E; V : E);
    procedure Set_Extra_Constrained               (Id : E; V : E);
    procedure Set_Extra_Formal                    (Id : E; V : E);
    procedure Set_Extra_Formals                   (Id : E; V : E);
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 178565)
+++ sem_util.adb	(working copy)
@@ -2878,6 +2878,22 @@
    function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id is
       E : Entity_Id;
       Loc : constant Source_Ptr := Sloc (Expr);
+
+      function Make_Level_Literal (Level : Uint) return Node_Id;
+      --  Construct an integer literal representing an accessibility level.
+
+      ---------------------------------
+      -- function Make_Level_Literal --
+      ---------------------------------
+
+      function Make_Level_Literal (Level : Uint) return Node_Id is
+         Result : constant Node_Id :=
+                    Make_Integer_Literal (Loc, Level);
+      begin
+         Set_Etype (Result, Standard_Natural);
+         return Result;
+      end Make_Level_Literal;
+
    begin
       if Is_Entity_Name (Expr) then
          E := Entity (Expr);
@@ -2903,7 +2919,7 @@
               and then Ekind (Etype (Entity (Selector_Name (Expr)))) =
               E_Anonymous_Access_Type then
 
-               return Make_Integer_Literal (Loc, Object_Access_Level (Expr));
+               return Make_Level_Literal (Object_Access_Level (Expr));
             end if;
 
          when N_Attribute_Reference =>
@@ -2912,15 +2928,14 @@
                --  For X'Access, the level of the prefix X
 
                when Attribute_Access =>
-                  return Make_Integer_Literal (Loc,
-                    Object_Access_Level (Prefix (Expr)));
+                  return Make_Level_Literal
+                           (Object_Access_Level (Prefix (Expr)));
 
                --  Treat the unchecked attributes as library-level
 
                when Attribute_Unchecked_Access |
                  Attribute_Unrestricted_Access =>
-                  return Make_Integer_Literal (Loc,
-                    Scope_Depth (Standard_Standard));
+                  return Make_Level_Literal (Scope_Depth (Standard_Standard));
 
                --  No other access-valued attributes
 
@@ -2947,7 +2962,7 @@
             null;
       end case;
 
-      return Make_Integer_Literal (Loc, Type_Access_Level (Etype (Expr)));
+      return Make_Level_Literal (Type_Access_Level (Etype (Expr)));
    end Dynamic_Accessibility_Level;
 
    -----------------------------------
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 178565)
+++ exp_ch4.adb	(working copy)
@@ -765,11 +765,38 @@
    --  Start of processing for Expand_Allocator_Expression
 
    begin
-      --  WOuld be nice to comment the branches of this very long if ???
+      --  Messy???
 
-      if Is_Tagged_Type (T)
-        or else Needs_Finalization (T)
-      then
+      --  In the case of an Ada2012 allocator whose initial value comes from a
+      --  function call, pass "the accessibility level determined by the point
+      --  of call" (AI05-0234) to the function. Conceptually, this belongs in
+      --  Expand_Call but it couldn't be done there (because the Etype of the
+      --  allocator wasn't set then) so we generate the parameter here. See
+      --  the Boolean variable Defer in (a block within) Expand_Call.
+
+      if Ada_Version >= Ada_2012 and then Nkind (Exp) = N_Function_Call then
+         declare
+            Subp : Entity_Id;
+
+         begin
+            if Nkind (Name (Exp)) = N_Explicit_Dereference then
+               Subp := Designated_Type (Etype (Prefix (Name (Exp))));
+            else
+               Subp := Entity (Name (Exp));
+            end if;
+
+            if Present (Extra_Accessibility_Of_Result (Subp)) then
+               Add_Extra_Actual_To_Call
+                 (Subprogram_Call => Exp,
+                  Extra_Formal    => Extra_Accessibility_Of_Result (Subp),
+                  Extra_Actual    => Dynamic_Accessibility_Level (PtrT));
+            end if;
+         end;
+      end if;
+
+      --  Would be nice to comment the branches of this very long if ???
+
+      if Is_Tagged_Type (T) or else Needs_Finalization (T) then
          if Is_CPP_Constructor_Call (Exp) then
 
             --  Generate:
@@ -811,10 +838,10 @@
 
                Insert_List_After_And_Analyze (P,
                  Build_Initialization_Call (Loc,
-                   Id_Ref =>
+                   Id_Ref          =>
                      Make_Explicit_Dereference (Loc,
                        Prefix => New_Reference_To (Temp, Loc)),
-                   Typ => Etype (Exp),
+                   Typ             => Etype (Exp),
                    Constructor_Ref => Exp));
             end;
 
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 178565)
+++ exp_ch6.adb	(working copy)
@@ -104,13 +104,6 @@
    --  present, then use it, otherwise pass a literal corresponding to the
    --  Alloc_Form parameter (which must not be Unspecified in that case).
 
-   procedure Add_Extra_Actual_To_Call
-     (Subprogram_Call : Node_Id;
-      Extra_Formal    : Entity_Id;
-      Extra_Actual    : Node_Id);
-   --  Adds Extra_Actual as a named parameter association for the formal
-   --  Extra_Formal in Subprogram_Call.
-
    procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
      (Func_Call  : Node_Id;
       Func_Id    : Entity_Id;
@@ -196,6 +189,11 @@
    --  reference to the object itself, and the call becomes a call to the
    --  corresponding protected subprogram.
 
+   function Has_Unconstrained_Access_Discriminants
+     (Subtyp : Entity_Id) return Boolean;
+   --  Returns True if the given subtype is unconstrained and has one
+   --  or more access discriminants.
+
    procedure Expand_Simple_Function_Return (N : Node_Id);
    --  Expand simple return from function. In the case where we are returning
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
@@ -2751,6 +2749,108 @@
          Next_Formal (Formal);
       end loop;
 
+      --  If we are calling an Ada2012 function which needs to have the
+      --  "accessibility level determined by the point of call" (AI05-0234)
+      --  passed in to it, then pass it in.
+
+      if Ada_Version >= Ada_2012
+         and then Ekind_In (Subp, E_Function, E_Operator, E_Subprogram_Type)
+         and then Present (Extra_Accessibility_Of_Result (Subp))
+      then
+         declare
+            Ancestor : Node_Id := Parent (Call_Node);
+            Level    : Node_Id := Empty;
+            Defer    : Boolean := False;
+
+         begin
+            --  Unimplemented: if Subp returns an anonymous access type, then
+            --    a) if the call is the operand of an explict conversion, then
+            --       the target type of the conversion (a named access type)
+            --       determines the accessibility level pass in;
+            --    b) if the call defines an access discriminant of an object
+            --       (e.g., the discriminant of an object being created by an
+            --       allocator, or the discriminant of a function result),
+            --       then the accessibility level to pass in is that of the
+            --       discriminated object being initialized).
+
+            while Nkind (Ancestor) = N_Qualified_Expression
+            loop
+               Ancestor := Parent (Ancestor);
+            end loop;
+
+            case Nkind (Ancestor) is
+               when N_Allocator =>
+                  --  Messy.
+                  --
+                  --  At this point, we'd like to assign
+                  --    Level := Dynamic_Accessibility_Level (Ancestor);
+                  --  but Etype of Ancestor may not have been set yet,
+                  --  so that doesn't work.
+                  --  Handle this later in Expand_Allocator_Expression.
+
+                  Defer := True;
+
+               when N_Object_Declaration | N_Object_Renaming_Declaration =>
+                  declare
+                     Def_Id : constant Entity_Id :=
+                                Defining_Identifier (Ancestor);
+                  begin
+                     if Is_Return_Object (Def_Id) then
+                        if Present (Extra_Accessibility_Of_Result
+                                     (Return_Applies_To (Scope (Def_Id))))
+                        then
+                           --  Pass along value that was passed in if the
+                           --  routine we are returning from also has an
+                           --  Accessibility_Of_Result formal.
+
+                           Level :=
+                             New_Occurrence_Of
+                              (Extra_Accessibility_Of_Result
+                                 (Return_Applies_To (Scope (Def_Id))), Loc);
+                        end if;
+                     else
+                        Level := Make_Integer_Literal (Loc,
+                                   Object_Access_Level (Def_Id));
+                     end if;
+                  end;
+
+               when N_Simple_Return_Statement =>
+                  if Present (Extra_Accessibility_Of_Result
+                    (Return_Applies_To (Return_Statement_Entity (Ancestor))))
+                  then
+                     --  Pass along value that was passed in if the routine
+                     --  we are returning from also has an
+                     --  Accessibility_Of_Result formal.
+
+                     Level :=
+                       New_Occurrence_Of
+                         (Extra_Accessibility_Of_Result
+                            (Return_Applies_To
+                               (Return_Statement_Entity (Ancestor))), Loc);
+                  end if;
+
+               when others =>
+                  null;
+            end case;
+
+            if not Defer then
+               if not Present (Level) then
+                  --  The "innermost master that evaluates the function call".
+                  --
+                  --  ??? -  Shuld we use Integer'Last here instead
+                  --  in order to deal with (some of) the problems
+                  --  associated with calls to subps whose enclosing
+                  --  scope is unknown (e.g., Anon_Access_To_Subp_Param.all)?
+
+                  Level := Make_Integer_Literal (Loc,
+                             Scope_Depth (Current_Scope) + 1);
+               end if;
+
+               Add_Extra_Actual (Level, Extra_Accessibility_Of_Result (Subp));
+            end if;
+         end;
+      end if;
+
       --  If we are expanding a rhs of an assignment we need to check if tag
       --  propagation is needed. You might expect this processing to be in
       --  Analyze_Assignment but has to be done earlier (bottom-up) because the
@@ -6146,6 +6246,31 @@
       end if;
    end Expand_Protected_Subprogram_Call;
 
+   --------------------------------------------
+   -- Has_Unconstrained_Access_Discriminants --
+   --------------------------------------------
+
+   function Has_Unconstrained_Access_Discriminants
+     (Subtyp : Entity_Id) return Boolean
+   is
+      Discr : Entity_Id;
+
+   begin
+      if Has_Discriminants (Subtyp)
+        and then not Is_Constrained (Subtyp)
+      then
+         Discr := First_Discriminant (Subtyp);
+         while Present (Discr) loop
+            if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
+               return True;
+            end if;
+
+            Next_Discriminant (Discr);
+         end loop;
+      end if;
+      return False;
+   end Has_Unconstrained_Access_Discriminants;
+
    -----------------------------------
    -- Expand_Simple_Function_Return --
    -----------------------------------
@@ -6604,6 +6729,216 @@
              Suppress  => All_Checks);
       end if;
 
+      --  AI05-0234: RM 6.5(21/3). Check access discriminants to
+      --  ensure that the function result does not outlive an
+      --  object designated by one of it discriminants.
+
+      if Ada_Version >= Ada_2012
+        and then Has_Unconstrained_Access_Discriminants (R_Type)
+      then
+         declare
+            Discrim_Source : Node_Id := Exp;
+
+            procedure Check_Against_Result_Level (Level : Node_Id);
+            --  Check the given accessibility level against the
+            --  level determined by the point of call" (AI05-0234).
+
+            --------------------------------
+            -- Check_Against_Result_Level --
+            --------------------------------
+
+            procedure Check_Against_Result_Level (Level : Node_Id) is
+            begin
+               Insert_Action (N,
+                 Make_Raise_Program_Error (Loc,
+                   Condition =>
+                     Make_Op_Gt (Loc,
+                       Left_Opnd  => Level,
+                       Right_Opnd =>
+                         New_Occurrence_Of
+                           (Extra_Accessibility_Of_Result (Scope_Id), Loc)),
+                       Reason => PE_Accessibility_Check_Failed));
+            end Check_Against_Result_Level;
+         begin
+            while Nkind (Discrim_Source) = N_Qualified_Expression loop
+               Discrim_Source := Expression (Discrim_Source);
+            end loop;
+
+            if Nkind (Discrim_Source) = N_Identifier
+              and then Is_Return_Object (Entity (Discrim_Source))
+            then
+
+               Discrim_Source := Entity (Discrim_Source);
+
+               if Is_Constrained (Etype (Discrim_Source)) then
+                  Discrim_Source := Etype (Discrim_Source);
+               else
+                  Discrim_Source := Expression (Parent (Discrim_Source));
+               end if;
+
+            elsif Nkind (Discrim_Source) = N_Identifier
+              and then Nkind_In (Original_Node (Discrim_Source),
+                                 N_Aggregate, N_Extension_Aggregate)
+            then
+
+               Discrim_Source := Original_Node (Discrim_Source);
+
+            elsif Nkind (Discrim_Source) = N_Explicit_Dereference and then
+              Nkind (Original_Node (Discrim_Source)) = N_Function_Call
+            then
+
+               Discrim_Source := Original_Node (Discrim_Source);
+
+            end if;
+
+            while Nkind_In (Discrim_Source, N_Qualified_Expression,
+                                            N_Type_Conversion,
+                                            N_Unchecked_Type_Conversion)
+            loop
+
+               Discrim_Source := Expression (Discrim_Source);
+            end loop;
+
+            case Nkind (Discrim_Source) is
+               when N_Defining_Identifier =>
+
+                  pragma Assert (Is_Composite_Type (Discrim_Source) and then
+                                 Has_Discriminants (Discrim_Source) and then
+                                 Is_Constrained (Discrim_Source));
+
+                  declare
+                     Discrim   : Entity_Id :=
+                                   First_Discriminant (Base_Type (R_Type));
+                     Disc_Elmt : Elmt_Id   :=
+                                   First_Elmt (Discriminant_Constraint
+                                                 (Discrim_Source));
+                  begin
+                     loop
+                        if Ekind (Etype (Discrim)) =
+                          E_Anonymous_Access_Type then
+
+                           Check_Against_Result_Level
+                             (Dynamic_Accessibility_Level (Node (Disc_Elmt)));
+                        end if;
+
+                        Next_Elmt (Disc_Elmt);
+                        Next_Discriminant (Discrim);
+                        exit when not Present (Discrim);
+                     end loop;
+                  end;
+
+               when N_Aggregate | N_Extension_Aggregate =>
+
+                  --  Unimplemented: extension aggregate case where
+                  --  discrims come from ancestor part, not extension part.
+
+                  declare
+                     Discrim  : Entity_Id :=
+                                  First_Discriminant (Base_Type (R_Type));
+
+                     Disc_Exp : Node_Id   := Empty;
+
+                     Positionals_Exhausted
+                              : Boolean   := not Present (Expressions
+                                                            (Discrim_Source));
+
+                     function Associated_Expr
+                       (Comp_Id : Entity_Id;
+                        Associations : List_Id) return Node_Id;
+
+                     --  Given a component and a component associations list,
+                     --  locate the expression for that component; returns
+                     --  Empty if no such expression is found.
+
+                     ---------------------
+                     -- Associated_Expr --
+                     ---------------------
+
+                     function Associated_Expr
+                       (Comp_Id : Entity_Id;
+                        Associations : List_Id) return Node_Id
+                     is
+                        Assoc  : Node_Id := First (Associations);
+                        Choice : Node_Id;
+                     begin
+                        --  Simple linear search seems ok here
+
+                        while Present (Assoc) loop
+                           Choice := First (Choices (Assoc));
+
+                           while Present (Choice) loop
+                              if (Nkind (Choice) = N_Identifier
+                                  and then Chars (Choice) = Chars (Comp_Id))
+                                 or else (Nkind (Choice) = N_Others_Choice)
+                              then
+                                 return Expression (Assoc);
+                              end if;
+
+                              Next (Choice);
+                           end loop;
+
+                           Next (Assoc);
+                        end loop;
+
+                        return Empty;
+                     end Associated_Expr;
+
+                  --  Start of processing for Expand_Simple_Function_Return
+
+                  begin
+                     if not Positionals_Exhausted then
+                        Disc_Exp := First (Expressions (Discrim_Source));
+                     end if;
+
+                     loop
+                        if Positionals_Exhausted then
+                           Disc_Exp := Associated_Expr (Discrim,
+                             Component_Associations (Discrim_Source));
+                        end if;
+
+                        if Ekind (Etype (Discrim)) =
+                          E_Anonymous_Access_Type then
+
+                           Check_Against_Result_Level
+                             (Dynamic_Accessibility_Level (Disc_Exp));
+                        end if;
+
+                        Next_Discriminant (Discrim);
+                        exit when not Present (Discrim);
+
+                        if not Positionals_Exhausted then
+                           Next (Disc_Exp);
+                           Positionals_Exhausted := not Present (Disc_Exp);
+                        end if;
+                     end loop;
+                  end;
+
+               when N_Function_Call =>
+                  --  No check needed; check performed by callee.
+                  null;
+
+               when others =>
+
+                  declare
+                     Level : constant Node_Id :=
+                        Make_Integer_Literal (Loc,
+                          Object_Access_Level (Discrim_Source));
+                  begin
+                     --  Unimplemented: check for name prefix that includes
+                     --  a dereference of an access value with a dynamic
+                     --  accessibility level (e.g., an access param or a
+                     --  saooaaat) and use dynamic level in that case. For
+                     --  example:
+                     --    return Access_Param.all(Some_Index).Some_Component;
+
+                     Set_Etype (Level, Standard_Natural);
+                     Check_Against_Result_Level (Level);
+                  end;
+
+            end case;
+         end;
+      end if;
+
       --  If we are returning an object that may not be bit-aligned, then copy
       --  the value into a temporary first. This copy may need to expand to a
       --  loop of component operations.
@@ -7923,4 +8258,116 @@
       return not Is_Constrained (Func_Typ) or else Is_Tagged_Type (Func_Typ);
    end Needs_BIP_Alloc_Form;
 
+   --------------------------------------
+   -- Needs_Result_Accessibility_Level --
+   --------------------------------------
+
+   function Needs_Result_Accessibility_Level
+     (Func_Id : Entity_Id) return Boolean
+   is
+      Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+
+      function Has_Unconstrained_Access_Discriminant_Component
+        (Comp_Typ :  Entity_Id) return Boolean;
+      --  Returns True if any component of the type has
+      --  an unconstrained access discriminant.
+
+      -----------------------------------------------------
+      -- Has_Unconstrained_Access_Discriminant_Component --
+      -----------------------------------------------------
+
+      function Has_Unconstrained_Access_Discriminant_Component
+        (Comp_Typ :  Entity_Id) return Boolean
+      is
+      begin
+         if not Is_Limited_Type (Comp_Typ) then
+            return False;
+            --  Only limited types can have access discriminants with
+            --  defaults.
+
+         elsif Has_Unconstrained_Access_Discriminants (Comp_Typ) then
+            return True;
+
+         elsif Is_Array_Type (Comp_Typ) then
+            return Has_Unconstrained_Access_Discriminant_Component
+                     (Underlying_Type (Component_Type (Comp_Typ)));
+
+         elsif Is_Record_Type (Comp_Typ) then
+            declare
+               Comp : Entity_Id := First_Component (Comp_Typ);
+            begin
+               while Present (Comp) loop
+                  if Has_Unconstrained_Access_Discriminant_Component
+                       (Underlying_Type (Etype (Comp)))
+                  then
+                     return True;
+                  end if;
+
+                  Next_Component (Comp);
+               end loop;
+            end;
+         end if;
+
+         return False;
+      end Has_Unconstrained_Access_Discriminant_Component;
+
+   --  Start of processing for Needs_Result_Accessibility_Level
+
+   begin
+      if not Present (Func_Typ) --  ??? completion unavailable
+
+        or else Func_Typ = Standard_Void_Type --  not a function
+
+        or else Is_Scalar_Type (Func_Typ) --  handle enum-lit renames
+      then
+         return False;
+      end if;
+
+      if Present (Alias (Func_Id)) then
+         --  Handle a corner case, a cross-dialect subp renaming. For example,
+         --  an Ada2012 renaming of an Ada05 subprogram. This can occur when
+         --  a non-Ada2012 unit references predefined runtime units.
+         --
+         --  Unimplemented: a cross-dialect subp renaming which does not set
+         --  the Alias attribute (e.g., a rename of a dereference of an access
+         --  to subprogram value).
+
+         return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
+      end if;
+
+      if Ada_Version < Ada_2012 then
+         return False;
+      end if;
+
+      if Ekind (Func_Typ) = E_Anonymous_Access_Type
+        or else Is_Tagged_Type (Func_Typ)
+      then
+         --  In the case of, say, a null tagged record result type, the need
+         --  for this extra parameter might not be obvious. This function
+         --  returns True for all tagged types for compatibility reasons.
+         --  A function with, say, a tagged null controlling result type might
+         --  be overridden by a primitive of an extension having an access
+         --  discriminant and the overrider and overridden must have compatible
+         --  calling conventions (including implicitly declared parameters).
+         --  Similarly, values of one access-to-subprogram type might designate
+         --  both a primitive subprogram of a given type and a function
+         --  which is, for example, not a primitive subprogram of any type.
+         --  Again, this requires calling convention compatibility.
+         --  It might be possible to solve these issues by introducing
+         --  wrappers, but that is not the approach that was chosen.
+
+         return True;
+      end if;
+
+      if Has_Unconstrained_Access_Discriminants (Func_Typ) then
+         return True;
+      end if;
+
+      if Has_Unconstrained_Access_Discriminant_Component (Func_Typ) then
+         return True;
+      end if;
+
+      return False;
+   end Needs_Result_Accessibility_Level;
+
 end Exp_Ch6;
Index: exp_ch6.ads
===================================================================
--- exp_ch6.ads	(revision 178565)
+++ exp_ch6.ads	(working copy)
@@ -205,4 +205,17 @@
    --  Ada 2005 (AI-318-02): Return True if the function needs an implicit
    --  BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
 
+   function Needs_Result_Accessibility_Level
+     (Func_Id : Entity_Id) return Boolean;
+   --  Ada 2012 (AI05-0234): Return True if the function needs an implicit
+   --  parameter to identify the accessibility level of the function result
+   --  "determined by the point of call".
+
+   procedure Add_Extra_Actual_To_Call
+     (Subprogram_Call : Node_Id;
+      Extra_Formal    : Entity_Id;
+      Extra_Actual    : Node_Id);
+   --  Adds Extra_Actual as a named parameter association for the formal
+   --  Extra_Formal in Subprogram_Call.
+
 end Exp_Ch6;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 178565)
+++ sem_ch6.adb	(working copy)
@@ -6296,7 +6296,7 @@
       --  build-in-place formals are needed in some cases (limited 'Input).
 
       if Is_Predefined_Internal_Operation (E) then
-         goto Test_For_BIP_Extras;
+         goto Test_For_Func_Result_Extras;
       end if;
 
       Formal := First_Formal (E);
@@ -6395,8 +6395,16 @@
          Next_Formal (Formal);
       end loop;
 
-      <<Test_For_BIP_Extras>>
+      <<Test_For_Func_Result_Extras>>
 
+      --  Ada 2012 (AI05-234): "the accessibility level of the result of a
+      --  function call is ... determined by the point of call ...".
+
+      if Needs_Result_Accessibility_Level (E) then
+         Set_Extra_Accessibility_Of_Result
+           (E, Add_Extra_Formal (E, Standard_Natural, E, "L"));
+      end if;
+
       --  Ada 2005 (AI-318-02): In the case of build-in-place functions, add
       --  appropriate extra formals. See type Exp_Ch6.BIP_Formal_Kind.
 
