mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-23 15:01:17 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r182230
This commit is contained in:
Arnaud Charlet 2011-12-12 13:03:35 +01:00
parent 6bed26b542
commit 033eaf8501
8 changed files with 51 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
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.

8
gcc/ada/exp_atag.adb
View File

@ -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;
------------------------------------------

1
gcc/ada/exp_atag.ads
View File

@ -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

14
gcc/ada/exp_attr.adb
View File

@ -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));
-- 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
-- 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.
New_Node := Convert_To (Typ, New_Node);
end if;

21
gcc/ada/exp_util.adb
View File

@ -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

5
gcc/ada/sem_ch13.adb
View File

@ -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);

13
gcc/ada/sem_ch6.adb
View File

@ -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;

9
gcc/ada/sem_ch7.adb
View File

@ -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))