layout.adb (SO_Ref_From_Expr): Change Subtype_Mark to Result_Definition.

2005-09-01  Gary Dismukes  <dismukes@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* layout.adb (SO_Ref_From_Expr): Change Subtype_Mark to
	Result_Definition.

	* par-ch6.adb (P_Subprogram): Handle parsing of Access_Definitions in
	function specs.
	Call Set_Result_Definition instead of Set_Subtype_Mark.
	(P_Subprogram_Specification): Add parsing of anonymous access result
	plus null exclusions. Call Set_Result_Definition instead of
	Set_Subtype_Mark.

	* par-ch3.adb: Add support for LIMITED NEW for Ada 2005 AI-419
	(P_Access_Type_Definition): Add parsing for an anonymous access result
	subtype, plus parsing for null exclusions. Call Set_Result_Definition
	instead of Set_Subtype_Mark.

	* sinfo.adb: Add support for LIMITED NEW for Ada 2005 AI-419
	(Null_Exclusion_Present): Allow this flag for N_Function_Specification.
	(Result_Definition): New function for N_Function_Specifications.
	(Subtype_Mark): No longer allowed for N_Access_Function_Definition and
	N_Function_Specification.
	(Set_Null_Exclusion_Present): Allow this flag for
	N_Function_Specification.
	(Set_Result_Definition): New procedure for N_Function_Specifications.
	(Set_Subtype_Mark): No longer allowed for N_Access_Function_Definition
	and N_Function_Specification.

	* sinfo.ads: Update grammar rules for 9.7.2: Entry_Call_Alternative,
	Procedure_Or_Entry_Call; 9.7.4: Triggering_Statement.
	Add support for LIMITED NEW for Ada 2005 AI-419
	Update the syntax of PARAMETER_AND_RESULT_PROFILE to reflect the new
	syntax for anonymous access results.
	Replace Subtype_Mark field by Result_Definition in
	N_Function_Specification and N_Access_Definition specs.
	Add Null_Exclusion_Present to spec of N_Function_Specification.
	(Result_Definition): New function for N_Function_Specification and
	N_Access_Function_Definition.
	(Set_Result_Definition): New procedure for N_Function_Specification and
	N_Access_Function_Definition.

	* sprint.adb (S_Print_Node_Actual): Change Subtype_Mark calls to
	Result_Definition for cases of N_Access_Function_Definition and
	N_Function_Specification.
	Print "not null" if Null_Exclusion_Present on N_Function_Specification.

From-SVN: r103869

6 files changed, 189 insertions, 49 deletions

diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index d1568f9..6f702c0 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -3017,7 +3017,7 @@ package body Layout is
                          Make_Defining_Identifier (Loc, Chars => Vname),
                        Parameter_Type      =>
                          New_Occurrence_Of (Vtype_Primary_View, Loc))),
-                   Subtype_Mark =>
+                   Result_Definition =>
                      New_Occurrence_Of (Standard_Unsigned, Loc)),
 
              Declarations => Empty_List,
@@ -3039,7 +3039,8 @@ package body Layout is
                Make_Function_Specification (Loc,
                  Defining_Unit_Name => K,
                    Parameter_Specifications => Empty_List,
-                   Subtype_Mark => New_Occurrence_Of (Standard_Unsigned, Loc)),
+                   Result_Definition =>
+                     New_Occurrence_Of (Standard_Unsigned, Loc)),
 
              Declarations => Empty_List,
 
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 695e89d..d4e84a5 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -644,6 +644,31 @@ package body Ch3 is
                      Is_Derived_Iface := True;
                   end if;
 
+                  --  Ada 2005 (AI-419): LIMITED NEW
+
+               elsif Token = Tok_New then
+                  if Ada_Version < Ada_05 then
+                     Error_Msg_SP
+                       ("LIMITED in derived type is an Ada 2005 extension");
+                     Error_Msg_SP
+                       ("\unit must be compiled with -gnat05 switch");
+                  end if;
+
+                  Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+                  Set_Limited_Present (Typedef_Node);
+
+                  if Nkind (Typedef_Node) = N_Derived_Type_Definition
+                    and then Present (Record_Extension_Part (Typedef_Node))
+                  then
+                     End_Labl :=
+                       Make_Identifier (Token_Ptr,
+                                        Chars => Chars (Ident_Node));
+                     Set_Comes_From_Source (End_Labl, False);
+
+                     Set_End_Label
+                       (Record_Extension_Part (Typedef_Node), End_Labl);
+                  end if;
+
                --  LIMITED PRIVATE is the only remaining possibility here
 
                else
@@ -853,6 +878,7 @@ package body Ch3 is
    function P_Subtype_Declaration return Node_Id is
       Decl_Node        : Node_Id;
       Not_Null_Present : Boolean := False;
+
    begin
       Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
       Scan; -- past SUBTYPE
@@ -1732,12 +1758,12 @@ package body Ch3 is
    -------------------------------------------------------------------------
 
    --  DERIVED_TYPE_DEFINITION ::=
-   --    [abstract] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
+   --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
    --    [[AND interface_list] RECORD_EXTENSION_PART]
 
    --  PRIVATE_EXTENSION_DECLARATION ::=
    --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
-   --       [abstract] new ancestor_SUBTYPE_INDICATION
+   --       [abstract] [limited] new ancestor_SUBTYPE_INDICATION
    --       [AND interface_list] with PRIVATE;
 
    --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
@@ -3579,6 +3605,8 @@ package body Ch3 is
       Prot_Flag             : Boolean;
       Not_Null_Present      : Boolean := False;
       Type_Def_Node         : Node_Id;
+      Result_Not_Null       : Boolean;
+      Result_Node           : Node_Id;
 
       procedure Check_Junk_Subprogram_Name;
       --  Used in access to subprogram definition cases to check for an
@@ -3649,8 +3677,32 @@ package body Ch3 is
          Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
          Set_Protected_Present (Type_Def_Node, Prot_Flag);
          TF_Return;
-         Set_Subtype_Mark (Type_Def_Node, P_Subtype_Mark);
-         No_Constraint;
+
+         Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+
+         --  Ada 2005 (AI-318-02)
+
+         if Token = Tok_Access then
+            if Ada_Version < Ada_05 then
+               Error_Msg_SC
+                 ("anonymous access result type is an Ada 2005 extension");
+               Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+            end if;
+
+            Result_Node := P_Access_Definition (Result_Not_Null);
+
+         else
+            Result_Node := P_Subtype_Mark;
+            No_Constraint;
+         end if;
+
+         --  Note: A null exclusion given on the result type needs to
+         --  be coded by a distinct flag, since Null_Exclusion_Present
+         --  on an access-to-function type pertains to a null exclusion
+         --  on the access type itself (as set above). ???
+         --  Set_Null_Exclusion_Present??? (Type_Def_Node, Result_Not_Null);
+
+         Set_Result_Definition (Type_Def_Node, Result_Node);
 
       else
          Type_Def_Node :=
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index f6a5874..6996007 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -138,19 +138,20 @@ package body Ch6 is
 
    function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id is
       Specification_Node : Node_Id;
-      Name_Node   : Node_Id;
-      Fpart_List  : List_Id;
-      Fpart_Sloc  : Source_Ptr;
-      Return_Node : Node_Id;
-      Inst_Node   : Node_Id;
-      Body_Node   : Node_Id;
-      Decl_Node   : Node_Id;
-      Rename_Node : Node_Id;
-      Absdec_Node : Node_Id;
-      Stub_Node   : Node_Id;
-      Fproc_Sloc  : Source_Ptr;
-      Func        : Boolean;
-      Scan_State  : Saved_Scan_State;
+      Name_Node          : Node_Id;
+      Fpart_List         : List_Id;
+      Fpart_Sloc         : Source_Ptr;
+      Result_Not_Null    : Boolean := False;
+      Result_Node        : Node_Id;
+      Inst_Node          : Node_Id;
+      Body_Node          : Node_Id;
+      Decl_Node          : Node_Id;
+      Rename_Node        : Node_Id;
+      Absdec_Node        : Node_Id;
+      Stub_Node          : Node_Id;
+      Fproc_Sloc         : Source_Ptr;
+      Func               : Boolean;
+      Scan_State         : Saved_Scan_State;
 
       --  Flags for optional overriding indication. Two flags are needed,
       --  to distinguish positive and negative overriding indicators from
@@ -318,7 +319,7 @@ package body Ch6 is
       --  since later RETURN statements will be valid in either case.
 
       Check_Junk_Semicolon_Before_Return;
-      Return_Node := Error;
+      Result_Node := Error;
 
       if Token = Tok_Return then
          if not Func then
@@ -327,8 +328,24 @@ package body Ch6 is
          end if;
 
          Scan; -- past RETURN
-         Return_Node := P_Subtype_Mark;
-         No_Constraint;
+
+         Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+
+         --  Ada 2005 (AI-318-02)
+
+         if Token = Tok_Access then
+            if Ada_Version < Ada_05 then
+               Error_Msg_SC
+                 ("anonymous access result type is an Ada 2005 extension");
+               Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+            end if;
+
+            Result_Node := P_Access_Definition (Result_Not_Null);
+
+         else
+            Result_Node := P_Subtype_Mark;
+            No_Constraint;
+         end if;
 
       else
          if Func then
@@ -340,7 +357,9 @@ package body Ch6 is
       if Func then
          Specification_Node :=
            New_Node (N_Function_Specification, Fproc_Sloc);
-         Set_Subtype_Mark (Specification_Node, Return_Node);
+
+         Set_Null_Exclusion_Present (Specification_Node, Result_Not_Null);
+         Set_Result_Definition (Specification_Node, Result_Node);
 
       else
          Specification_Node :=
@@ -618,6 +637,8 @@ package body Ch6 is
 
    function P_Subprogram_Specification return Node_Id is
       Specification_Node : Node_Id;
+      Result_Not_Null    : Boolean;
+      Result_Node        : Node_Id;
 
    begin
       if Token = Tok_Function then
@@ -629,8 +650,27 @@ package body Ch6 is
            (Specification_Node, P_Parameter_Profile);
          Check_Junk_Semicolon_Before_Return;
          TF_Return;
-         Set_Subtype_Mark (Specification_Node, P_Subtype_Mark);
-         No_Constraint;
+
+         Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+
+         --  Ada 2005 (AI-318-02)
+
+         if Token = Tok_Access then
+            if Ada_Version < Ada_05 then
+               Error_Msg_SC
+                 ("anonymous access result type is an Ada 2005 extension");
+               Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+            end if;
+
+            Result_Node := P_Access_Definition (Result_Not_Null);
+
+         else
+            Result_Node := P_Subtype_Mark;
+            No_Constraint;
+         end if;
+
+         Set_Null_Exclusion_Present (Specification_Node, Result_Not_Null);
+         Set_Result_Definition (Specification_Node, Result_Node);
          return Specification_Node;
 
       elsif Token = Tok_Procedure then
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 553e789..83e094c 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1668,6 +1668,7 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
         or else NT (N).Nkind = N_Record_Definition
         or else NT (N).Nkind = N_With_Clause);
@@ -1915,6 +1916,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Component_Definition
         or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Discriminant_Specification
+        or else NT (N).Nkind = N_Function_Specification
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Subtype_Declaration);
@@ -2243,6 +2245,15 @@ package body Sinfo is
       return Flag13 (N);
    end Redundant_Use;
 
+   function Result_Definition
+     (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Access_Function_Definition
+        or else NT (N).Nkind = N_Function_Specification);
+      return Node4 (N);
+   end Result_Definition;
+
    function Return_Type
       (N : Node_Id) return Node_Id is
    begin
@@ -2415,10 +2426,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Definition
-        or else NT (N).Nkind = N_Access_Function_Definition
         or else NT (N).Nkind = N_Formal_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Object_Declaration
-        or else NT (N).Nkind = N_Function_Specification
         or else NT (N).Nkind = N_Object_Renaming_Declaration
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Subtype_Indication
@@ -4220,6 +4229,7 @@ package body Sinfo is
       pragma Assert (False
         or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
+        or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
         or else NT (N).Nkind = N_Record_Definition
         or else NT (N).Nkind = N_With_Clause);
@@ -4467,6 +4477,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Component_Definition
         or else NT (N).Nkind = N_Derived_Type_Definition
         or else NT (N).Nkind = N_Discriminant_Specification
+        or else NT (N).Nkind = N_Function_Specification
         or else NT (N).Nkind = N_Object_Declaration
         or else NT (N).Nkind = N_Parameter_Specification
         or else NT (N).Nkind = N_Subtype_Declaration);
@@ -4795,6 +4806,15 @@ package body Sinfo is
       Set_Flag13 (N, Val);
    end Set_Redundant_Use;
 
+   procedure Set_Result_Definition
+     (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Access_Function_Definition
+        or else NT (N).Nkind = N_Function_Specification);
+      Set_Node4_With_Parent (N, Val);
+   end Set_Result_Definition;
+
    procedure Set_Return_Type
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -4967,10 +4987,8 @@ package body Sinfo is
    begin
       pragma Assert (False
         or else NT (N).Nkind = N_Access_Definition
-        or else NT (N).Nkind = N_Access_Function_Definition
         or else NT (N).Nkind = N_Formal_Derived_Type_Definition
         or else NT (N).Nkind = N_Formal_Object_Declaration
-        or else NT (N).Nkind = N_Function_Specification
         or else NT (N).Nkind = N_Object_Renaming_Declaration
         or else NT (N).Nkind = N_Qualified_Expression
         or else NT (N).Nkind = N_Subtype_Indication
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 5172e55..6bc6926 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1120,6 +1120,11 @@ package Sinfo is
    --    suppress any warnings that would otherwise be issued inside the
    --    loop since they are probably not useful.
 
+   --  Is_Overloaded (Flag5-Sem)
+   --    A flag present in all expression nodes. Used temporarily during
+   --    overloading determination. The setting of this flag is not
+   --    relevant once overloading analysis is complete.
+
    --  Is_Power_Of_2_For_Shift (Flag13-Sem)
    --    A flag present only in N_Op_Expon nodes. It is set when the
    --    exponentiation is of the forma 2 ** N, where the type of N is
@@ -2052,10 +2057,11 @@ package Sinfo is
       ----------------------------------
 
       --  DERIVED_TYPE_DEFINITION ::=
-      --    [abstract] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
+      --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
       --    [[and INTERFACE_LIST] RECORD_EXTENSION_PART]
 
-      --  Note: ABSTRACT, record extension part not permitted in Ada 83 mode
+   --  Note: ABSTRACT, LIMITED and record extension part are not permitted
+   --  in Ada 83 mode
 
       --  Note: a record extension part is required if ABSTRACT is present
 
@@ -2065,17 +2071,16 @@ package Sinfo is
       --  Null_Exclusion_Present (Flag11) (set to False if not present)
       --  Subtype_Indication (Node5)
       --  Record_Extension_Part (Node3) (set to Empty if not present)
-      --  Limited_Present (Flag17) set in interfaces
+      --  Limited_Present (Flag17)
       --  Task_Present (Flag5) set in task interfaces
       --  Protected_Present (Flag6) set in protected interfaces
       --  Synchronized_Present (Flag7) set in interfaces
       --  Interface_List (List2) (set to No_List if none)
       --  Interface_Present (Flag16) set in abstract interfaces
 
-      --  Note: The attributes Limited_Present, Task_Present, Protected_Present
-      --        Synchronized_Present, Interface_List and Interface_Present are
-      --        used for abstract interfaces (see comment in the definition
-      --        of INTERFACE_TYPE_DEFINITION)
+   --  Note: Task_Present, Protected_Present, Synchronized_Present,
+   --        Interface_List, and Interface_Present are used for abstract
+   --        interfaces (see comments for INTERFACE_TYPE_DEFINITION).
 
       ---------------------------
       -- 3.5  Range Constraint --
@@ -2531,10 +2536,9 @@ package Sinfo is
       --  Interface_Present (Flag16) set in abstract interfaces
       --  Interface_List (List2) (set to No_List if none)
 
-      --  Note: The attributes Task_Present, Protected_Present, Synchronized
-      --        _Present, Interface_List and Interface_Present are
-      --        used for abstract interfaces (see comment in the definition
-      --        of INTERFACE_TYPE_DEFINITION)
+      --  Note: Task_Present, Protected_Present, Synchronized _Present,
+      --        Interface_List and Interface_Present are used for abstract
+      --        interfaces (see comments for INTERFACE_TYPE_DEFINITION).
 
       -------------------------
       -- 3.8  Component List --
@@ -2731,7 +2735,7 @@ package Sinfo is
       --  Null_Exclusion_Present (Flag11)
       --  Protected_Present (Flag6)
       --  Parameter_Specifications (List3) (set to No_List if no formal part)
-      --  Subtype_Mark (Node4) result subtype
+      --  Result_Definition (Node4) result subtype (subtype mark or access def)
 
       --  N_Access_Procedure_Definition
       --  Sloc points to ACCESS
@@ -3913,7 +3917,8 @@ package Sinfo is
       --  Defining_Unit_Name (Node1) (the designator)
       --  Elaboration_Boolean (Node2-Sem)
       --  Parameter_Specifications (List3) (set to No_List if no formal part)
-      --  Subtype_Mark (Node4) for return type
+      --  Null_Exclusion_Present (Flag11)
+      --  Result_Definition (Node4) for result subtype
       --  Generic_Parent (Node5-Sem)
       --  Must_Override (Flag14) set if overriding indicator present
       --  Must_Not_Override (Flag15) set if not_overriding indicator present
@@ -4041,7 +4046,9 @@ package Sinfo is
       -- 6.1  Parameter and Result Profile --
       ---------------------------------------
 
-      --  PARAMETER_AND_RESULT_PROFILE ::= [FORMAL_PART] return SUBTYPE_MARK
+      --  PARAMETER_AND_RESULT_PROFILE ::=
+      --    [FORMAL_PART] return [NULL_EXCLUSION] SUBTYPE_MARK
+      --  | [FORMAL_PART] return ACCESS_DEFINITION
 
       --  There is no explicit node in the tree for a parameter and result
       --  profile. Instead the information appears directly in the parent.
@@ -4315,10 +4322,11 @@ package Sinfo is
 
       --  PRIVATE_EXTENSION_DECLARATION ::=
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
-      --      [abstract] new ancestor_SUBTYPE_INDICATION
+      --      [abstract] [limited] new ancestor_SUBTYPE_INDICATION
       --      [and INTERFACE_LIST] with private;
 
-      --  Note: private extension declarations are not allowed in Ada 83 mode
+   --  Note: LIMITED, and private extension declarations are not allowed
+   --        in Ada 83 mode.
 
       --  N_Private_Extension_Declaration
       --  Sloc points to TYPE
@@ -4327,6 +4335,7 @@ package Sinfo is
       --   discriminant part)
       --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
       --  Abstract_Present (Flag4)
+      --  Limited_Present (Flag17)
       --  Subtype_Indication (Node5)
       --  Interface_List (List2) (set to No_List if none)
 
@@ -4956,7 +4965,10 @@ package Sinfo is
       -----------------------------------
 
       --  ENTRY_CALL_ALTERNATIVE ::=
-      --    ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
+      --    PROCEDURE_OR_ENTRY_CALL [SEQUENCE_OF_STATEMENTS]
+
+      --  PROCEDURE_OR_ENTRY_CALL ::=
+      --    PROCEDURE_CALL_STATEMENT | ENTRY_CALL_STATEMENT
 
       --  Gigi restriction: This node never appears
 
@@ -5023,7 +5035,7 @@ package Sinfo is
       -- 9.7.4  Triggering Statement --
       ---------------------------------
 
-      --  TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
+      --  TRIGGERING_STATEMENT ::= PROCEDURE_OR_ENTRY_CALL | DELAY_STATEMENT
 
       ---------------------------
       -- 9.7.4  Abortable Part --
@@ -7742,6 +7754,9 @@ package Sinfo is
    function Redundant_Use
      (N : Node_Id) return Boolean;    -- Flag13
 
+   function Result_Definition
+     (N : Node_Id) return Node_Id;    -- Node4
+
    function Return_Type
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -8549,6 +8564,9 @@ package Sinfo is
    procedure Set_Redundant_Use
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
+   procedure Set_Result_Definition
+     (N : Node_Id; Val : Node_Id);            -- Node4
+
    procedure Set_Return_Type
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -8921,6 +8939,7 @@ package Sinfo is
    pragma Inline (Reason);
    pragma Inline (Record_Extension_Part);
    pragma Inline (Redundant_Use);
+   pragma Inline (Result_Definition);
    pragma Inline (Return_Type);
    pragma Inline (Reverse_Present);
    pragma Inline (Right_Opnd);
@@ -9186,6 +9205,7 @@ package Sinfo is
    pragma Inline (Set_Reason);
    pragma Inline (Set_Record_Extension_Part);
    pragma Inline (Set_Redundant_Use);
+   pragma Inline (Set_Result_Definition);
    pragma Inline (Set_Return_Type);
    pragma Inline (Set_Reverse_Present);
    pragma Inline (Set_Right_Opnd);
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 94347f4..58e61df 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -749,7 +749,7 @@ package body Sprint is
             Write_Str_With_Col_Check ("function");
             Write_Param_Specs (Node);
             Write_Str_With_Col_Check (" return ");
-            Sprint_Node (Subtype_Mark (Node));
+            Sprint_Node (Result_Definition (Node));
 
          when N_Access_Procedure_Definition =>
 
@@ -1546,7 +1546,16 @@ package body Sprint is
             Sprint_Node (Defining_Unit_Name (Node));
             Write_Param_Specs (Node);
             Write_Str_With_Col_Check (" return ");
-            Sprint_Node (Subtype_Mark (Node));
+
+            --  Ada 2005 (AI-231)
+
+            if Nkind (Result_Definition (Node)) /= N_Access_Definition
+              and then Null_Exclusion_Present (Node)
+            then
+               Write_Str (" not null ");
+            end if;
+
+            Sprint_Node (Result_Definition (Node));
 
          when N_Generic_Association =>
             Set_Debug_Sloc;