2011-12-12 Robert Dewar <dewar@adacore.com>

	* exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb,
	sem_ch13.adb: Minor reformatting.

2011-12-12  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch7.adb (Uninstall_Declarations): Don't
	apply check for incomplete types used as a result type for an
	access-to-function type when compiling for Ada 2012 or later.
	* sem_ch6.adb (Analyze_Subprogram_Declaration):
	Specialize error message for interface subprograms that are
	not declared abstract nor null (functions can't be declared as
	null). Also, remove "(Ada 2005)" from message.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182230 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 51 insertions, 35 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6653a2f4ffa..dea19c8888b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,20 @@
 2011-12-12  Robert Dewar  <dewar@adacore.com>
 
+	* exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb,
+	sem_ch13.adb: Minor reformatting.
+
+2011-12-12  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch7.adb (Uninstall_Declarations): Don't
+	apply check for incomplete types used as a result type for an
+	access-to-function type when compiling for Ada 2012 or later.
+	* sem_ch6.adb (Analyze_Subprogram_Declaration):
+	Specialize error message for interface subprograms that are
+	not declared abstract nor null (functions can't be declared as
+	null). Also, remove "(Ada 2005)" from message.
+
+2011-12-12  Robert Dewar  <dewar@adacore.com>
+
 	* sem_prag.adb (GNAT_Pragma): Check comes from source.
 
 2011-12-12  Robert Dewar  <dewar@adacore.com>
diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb
index 2b0a03824cf..60201453794 100644
--- a/gcc/ada/exp_atag.adb
+++ b/gcc/ada/exp_atag.adb
@@ -300,12 +300,10 @@ package body Exp_Atag is
    begin
       return
         Make_Selected_Component (Loc,
-          Prefix =>
-            Build_TSD (Loc,
-              Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+          Prefix        =>
+            Build_TSD (Loc, Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
           Selector_Name =>
-            New_Reference_To
-              (RTE_Record_Component (RE_Alignment), Loc));
+            New_Reference_To (RTE_Record_Component (RE_Alignment), Loc));
    end Build_Get_Alignment;
 
    ------------------------------------------
diff --git a/gcc/ada/exp_atag.ads b/gcc/ada/exp_atag.ads
index 7544925d8a0..6551f153aa9 100644
--- a/gcc/ada/exp_atag.ads
+++ b/gcc/ada/exp_atag.ads
@@ -70,7 +70,6 @@ package Exp_Atag is
      (Loc      : Source_Ptr;
       Tag_Node : Node_Id) return Node_Id;
    --  Build code that retrieves the alignment of the tagged type.
-   --
    --  Generates: TSD (Tag).Alignment
 
    procedure Build_Get_Predefined_Prim_Op_Address
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 8258f7114fa..111dc8de02b 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1119,20 +1119,18 @@ package body Exp_Attr is
          --  operation _Alignment applied to X.
 
          elsif Is_Class_Wide_Type (Ptyp) then
-
             New_Node :=
               Build_Get_Alignment (Loc,
                 Make_Attribute_Reference (Loc,
-                  Prefix => Pref,
+                  Prefix         => Pref,
                   Attribute_Name => Name_Tag));
 
-            if Typ /= Standard_Integer then
-
-               --  The context is a specific integer type with which the
-               --  original attribute was compatible. The function has a
-               --  specific type as well, so to preserve the compatibility
-               --  we must convert explicitly.
+            --  Case where the context is a specific integer type with which
+            --  the original attribute was compatible. The function has a
+            --  specific type as well, so to preserve the compatibility we
+            --  must convert explicitly.
 
+            if Typ /= Standard_Integer then
                New_Node := Convert_To (Typ, New_Node);
             end if;
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3dd99e9e6f0..52541ed67eb 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -756,9 +756,7 @@ package body Exp_Util is
          Append_To (Actuals, New_Reference_To (Addr_Id, Loc));
          Append_To (Actuals, New_Reference_To (Size_Id, Loc));
 
-         if Is_Allocate
-           or else not Is_Class_Wide_Type (Desig_Typ)
-         then
+         if Is_Allocate or else not Is_Class_Wide_Type (Desig_Typ) then
             Append_To (Actuals, New_Reference_To (Alig_Id, Loc));
 
          --  For deallocation of class wide types we obtain the value of
@@ -777,7 +775,7 @@ package body Exp_Util is
             Append_To (Actuals,
               Unchecked_Convert_To (RTE (RE_Storage_Offset),
                 Make_Attribute_Reference (Loc,
-                  Prefix =>
+                  Prefix         =>
                     Make_Explicit_Dereference (Loc, Relocate_Node (Expr)),
                   Attribute_Name => Name_Alignment)));
          end if;
@@ -879,6 +877,7 @@ package body Exp_Util is
             else
                Append_To (Actuals, New_Reference_To (Standard_True, Loc));
             end if;
+
          else
             Append_To (Actuals, New_Reference_To (Standard_False, Loc));
          end if;
@@ -917,8 +916,7 @@ package body Exp_Util is
                   --  P : Root_Storage_Pool
 
                    Make_Parameter_Specification (Loc,
-                     Defining_Identifier =>
-                       Make_Temporary (Loc, 'P'),
+                     Defining_Identifier => Make_Temporary (Loc, 'P'),
                      Parameter_Type =>
                        New_Reference_To (RTE (RE_Root_Storage_Pool), Loc)),
 
@@ -926,22 +924,22 @@ package body Exp_Util is
 
                    Make_Parameter_Specification (Loc,
                      Defining_Identifier => Addr_Id,
-                     Out_Present => Is_Allocate,
-                     Parameter_Type =>
+                     Out_Present         => Is_Allocate,
+                     Parameter_Type      =>
                        New_Reference_To (RTE (RE_Address), Loc)),
 
                   --  S : Storage_Count
 
                    Make_Parameter_Specification (Loc,
                      Defining_Identifier => Size_Id,
-                     Parameter_Type =>
+                     Parameter_Type      =>
                        New_Reference_To (RTE (RE_Storage_Count), Loc)),
 
                   --  L : Storage_Count
 
                    Make_Parameter_Specification (Loc,
                      Defining_Identifier => Alig_Id,
-                     Parameter_Type =>
+                     Parameter_Type      =>
                        New_Reference_To (RTE (RE_Storage_Count), Loc)))),
 
              Declarations => No_List,
@@ -950,8 +948,7 @@ package body Exp_Util is
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (
                    Make_Procedure_Call_Statement (Loc,
-                     Name =>
-                       New_Reference_To (Proc_To_Call, Loc),
+                     Name => New_Reference_To (Proc_To_Call, Loc),
                      Parameter_Associations => Actuals)))));
 
          --  The newly generated Allocate / Deallocate becomes the default
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8b543a3d9b3..d06ba9388ac 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2497,6 +2497,7 @@ package body Sem_Ch13 is
          when Attribute_Alignment => Alignment : declare
             Align     : constant Uint := Get_Alignment_Value (Expr);
             Max_Align : constant Uint := UI_From_Int (Maximum_Alignment);
+
          begin
             FOnly := True;
 
@@ -2512,9 +2513,7 @@ package body Sem_Ch13 is
             elsif Align /= No_Uint then
                Set_Has_Alignment_Clause (U_Ent);
 
-               if Is_Tagged_Type (U_Ent)
-                 and then Align > Max_Align
-               then
+               if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
                   Error_Msg_N
                     ("?alignment for & set to Maximum_Aligment", Nam);
                   Set_Alignment (U_Ent, Max_Align);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 2cc899e934a..846f3a30066 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3256,9 +3256,16 @@ package body Sem_Ch6 is
                               and then Null_Present (Specification (N)))
             then
                Error_Msg_Name_1 := Chars (Defining_Entity (N));
-               Error_Msg_N
-                 ("(Ada 2005) interface subprogram % must be abstract or null",
-                  N);
+
+               --  Specialize error message based on procedures vs. functions,
+               --  since functions can't be null subprograms.
+
+               if Ekind (Designator) = E_Procedure then
+                  Error_Msg_N
+                    ("interface procedure % must be abstract or null", N);
+               else
+                  Error_Msg_N ("interface function % must be abstract", N);
+               end if;
             end if;
          end;
       end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index e1453d0c1e8..2f87cf07885 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2474,10 +2474,13 @@ package body Sem_Ch7 is
                        ("type& must be completed in the private part",
                          Parent (Subp), Id);
 
-                  --  The return type of an access_to_function cannot be a
-                  --  Taft-amendment type.
+                  --  The result type of an access-to-function type cannot be a
+                  --  Taft-amendment type, unless the version is Ada 2012 or
+                  --  later (see AI05-151).
 
-                  elsif Ekind (Subp) = E_Subprogram_Type then
+                  elsif Ada_Version < Ada_2012
+                    and then Ekind (Subp) = E_Subprogram_Type
+                  then
                      if Etype (Subp) = Id
                        or else
                          (Is_Class_Wide_Type (Etype (Subp))