mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 11:40:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-10-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): For Address
	attribute, consider it to be set in source, because of aliasing
	considerations.
	(Analyze_Attribute_Definition_Clause): For the
	purpose of warning on overlays, take into account the aspect case.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads, a-cforse.ads,
	a-cofove.ads: Minor reformatting.

2013-10-10  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi: Remove obsolete mention to -laddr2line.

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Case_Expression):  Indicate that the
	generated variable used as a target of the expression needs
	no initialization.

2013-10-10  Jose Ruiz  <ruiz@adacore.com>

	* exp_util.adb (Corresponding_Runtime_Package): Remove the condition
	related to No_Dynamic_Attachment which was wrong. Protected types
	with interrupt handlers (when not using a restricted profile)
	are always treated as protected types with entries, regardless
	of the No_Dynamic_Attachment restriction.
	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Simplify the code
	using the result of Corresponding_Runtime_Package.
	(Install_Private_Data_Declarations): When having
	static handlers and a non restricted profile, we use the
	type Static_Interrupt_Protection always, so we removed an
	extra wrong condition looking at the No_Dynamic_Attachment
	restriction. Simplify the code using the result of
	Corresponding_Runtime_Package.
	(Make_Initialize_Protection): Simplify the code using
	the result of Corresponding_Runtime_Package.
	(Install_Private_Data_Declaration): The No_Dynamic_Attachment
	restriction has nothing to do with static handlers. Remove the extra
	erroneous condition that was creating the wrong data type.

2013-10-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Is_Object_Reference): Attribute
	'Old produces an object reference.
	* gnat_rm.texi: Define accessibility level of
	X'Update(...) result.

From-SVN: r203348
This commit is contained in:
Arnaud Charlet 2013-10-10 12:59:13 +02:00
parent 2fc0728559
commit 27a8f15020
14 changed files with 211 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
gcc/ada/ChangeLog
View File

@ -1,3 +1,54 @@
2013-10-10 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): For Address
attribute, consider it to be set in source, because of aliasing
considerations.
(Analyze_Attribute_Definition_Clause): For the
purpose of warning on overlays, take into account the aspect case.
2013-10-10 Robert Dewar <dewar@adacore.com>
* a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads, a-cforse.ads,
a-cofove.ads: Minor reformatting.
2013-10-10 Arnaud Charlet <charlet@adacore.com>
* gnat_ugn.texi: Remove obsolete mention to -laddr2line.
2013-10-10 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Case_Expression): Indicate that the
generated variable used as a target of the expression needs
no initialization.
2013-10-10 Jose Ruiz <ruiz@adacore.com>
* exp_util.adb (Corresponding_Runtime_Package): Remove the condition
related to No_Dynamic_Attachment which was wrong. Protected types
with interrupt handlers (when not using a restricted profile)
are always treated as protected types with entries, regardless
of the No_Dynamic_Attachment restriction.
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Simplify the code
using the result of Corresponding_Runtime_Package.
(Install_Private_Data_Declarations): When having
static handlers and a non restricted profile, we use the
type Static_Interrupt_Protection always, so we removed an
extra wrong condition looking at the No_Dynamic_Attachment
restriction. Simplify the code using the result of
Corresponding_Runtime_Package.
(Make_Initialize_Protection): Simplify the code using
the result of Corresponding_Runtime_Package.
(Install_Private_Data_Declaration): The No_Dynamic_Attachment
restriction has nothing to do with static handlers. Remove the extra
erroneous condition that was creating the wrong data type.
2013-10-10 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Is_Object_Reference): Attribute
'Old produces an object reference.
* gnat_rm.texi: Define accessibility level of
X'Update(...) result.
2013-10-10 Yannick Moy <moy@adacore.com>
* gnat_rm.texi, a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads,

2
gcc/ada/a-cfdlli.ads
View File

@ -51,7 +51,7 @@
-- function Left (Container : List; Position : Cursor) return List;
-- function Right (Container : List; Position : Cursor) return List;
-- See subprogram specifications that follow for details.
-- See subprogram specifications that follow for details
generic
type Element_Type is private;

2
gcc/ada/a-cfhama.ads
View File

@ -51,7 +51,7 @@
-- function Left (Container : Map; Position : Cursor) return Map;
-- function Right (Container : Map; Position : Cursor) return Map;
-- See detailed specifications for these subprograms.
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;

2
gcc/ada/a-cfhase.ads
View File

@ -51,7 +51,7 @@
-- function Left (Container : Set; Position : Cursor) return Set;
-- function Right (Container : Set; Position : Cursor) return Set;
-- See detailed specifications for these subprograms.
-- See detailed specifications for these subprograms
private with Ada.Containers.Hash_Tables;

2
gcc/ada/a-cforma.ads
View File

@ -53,7 +53,7 @@
-- function Left (Container : Map; Position : Cursor) return Map;
-- function Right (Container : Map; Position : Cursor) return Map;
-- See detailed specifications for these subprograms.
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;

2
gcc/ada/a-cforse.ads
View File

@ -52,7 +52,7 @@
-- function Left (Container : Set; Position : Cursor) return Set;
-- function Right (Container : Set; Position : Cursor) return Set;
-- See detailed specifications for these subprograms.
-- See detailed specifications for these subprograms
private with Ada.Containers.Red_Black_Trees;

2
gcc/ada/a-cofove.ads
View File

@ -50,7 +50,7 @@
-- function Left (Container : Vector; Position : Cursor) return Vector;
-- function Right (Container : Vector; Position : Cursor) return Vector;
-- See detailed specifications for these subprograms.
-- See detailed specifications for these subprograms
with Ada.Containers;
use Ada.Containers;

12
gcc/ada/exp_ch4.adb
View File

@ -4891,6 +4891,7 @@ package body Exp_Ch4 is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Cstmt : Node_Id;
Decl : Node_Id;
Tnn : Entity_Id;
Pnn : Entity_Id;
Actions : List_Id;
@ -4967,10 +4968,15 @@ package body Exp_Ch4 is
end if;
Tnn := Make_Temporary (Loc, 'T');
Append_To (Actions,
Make_Object_Declaration (Loc,
-- Create declaration for target of expression, and indicate that it
-- does not require initialization.
Decl := Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Object_Definition => New_Occurrence_Of (Ttyp, Loc)));
Object_Definition => New_Occurrence_Of (Ttyp, Loc));
Set_No_Initialization (Decl);
Append_To (Actions, Decl);
-- Now process the alternatives

230
gcc/ada/exp_ch9.adb
View File

@ -8987,8 +8987,6 @@ package body Exp_Ch9 is
(Prot_Typ, Cdecls, Loc);
begin
-- Could this be simplified using Corresponding_Runtime_Package???
if Has_Attach_Handler (Prot_Typ) then
Ritem := First_Rep_Item (Prot_Typ);
while Present (Ritem) loop
@ -9000,47 +8998,40 @@ package body Exp_Ch9 is
Next_Rep_Item (Ritem);
end loop;
end if;
if Restricted_Profile then
if Has_Entries (Prot_Typ) then
Protection_Subtype :=
New_Reference_To (RTE (RE_Protection_Entry), Loc);
else
Protection_Subtype :=
New_Reference_To (RTE (RE_Protection), Loc);
end if;
-- Determine the proper protection type. There are two special
-- cases: 1) when the protected type has dynamic interrupt
-- handlers, and 2) when it has static handlers and we use a
-- restricted profile.
else
Protection_Subtype :=
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Reference_To
(RTE (RE_Static_Interrupt_Protection), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Entry_Count_Expr,
Make_Integer_Literal (Loc, Num_Attach_Handler))));
end if;
if Has_Attach_Handler (Prot_Typ)
and then not Restricted_Profile
then
Protection_Subtype :=
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Reference_To
(RTE (RE_Static_Interrupt_Protection), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Entry_Count_Expr,
Make_Integer_Literal (Loc, Num_Attach_Handler))));
elsif Has_Interrupt_Handler (Prot_Typ)
and then not Restriction_Active (No_Dynamic_Attachment)
then
Protection_Subtype :=
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Reference_To
(RTE (RE_Dynamic_Interrupt_Protection), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (Entry_Count_Expr)));
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Reference_To
(RTE (RE_Dynamic_Interrupt_Protection), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (Entry_Count_Expr)));
-- Type has explicit entries or generated primitive entry wrappers
elsif Has_Entries (Prot_Typ)
or else (Ada_Version >= Ada_2005
and then Present (Interface_List (N)))
then
else
case Corresponding_Runtime_Package (Prot_Typ) is
when System_Tasking_Protected_Objects_Entries =>
Protection_Subtype :=
@ -9056,13 +9047,13 @@ package body Exp_Ch9 is
Protection_Subtype :=
New_Reference_To (RTE (RE_Protection_Entry), Loc);
when System_Tasking_Protected_Objects =>
Protection_Subtype :=
New_Reference_To (RTE (RE_Protection), Loc);
when others =>
raise Program_Error;
end case;
else
Protection_Subtype :=
New_Reference_To (RTE (RE_Protection), Loc);
end if;
Object_Comp :=
@ -13095,7 +13086,6 @@ package body Exp_Ch9 is
if Has_Attach_Handler (Conc_Typ)
and then not Restricted_Profile
and then not Restriction_Active (No_Dynamic_Attachment)
then
Prot_Typ := RE_Static_Interrupt_Protection;
@ -13104,14 +13094,7 @@ package body Exp_Ch9 is
then
Prot_Typ := RE_Dynamic_Interrupt_Protection;
-- The type has explicit entries or generated primitive entry
-- wrappers.
elsif Has_Entries (Conc_Typ)
or else
(Ada_Version >= Ada_2005
and then Present (Interface_List (Parent (Conc_Typ))))
then
else
case Corresponding_Runtime_Package (Conc_Typ) is
when System_Tasking_Protected_Objects_Entries =>
Prot_Typ := RE_Protection_Entries;
@ -13119,12 +13102,12 @@ package body Exp_Ch9 is
when System_Tasking_Protected_Objects_Single_Entry =>
Prot_Typ := RE_Protection_Entry;
when System_Tasking_Protected_Objects =>
Prot_Typ := RE_Protection;
when others =>
raise Program_Error;
end case;
else
Prot_Typ := RE_Protection;
end if;
-- Generate:
@ -13659,91 +13642,104 @@ package body Exp_Ch9 is
-- considered equivalent to a protected type with entries in the
-- context of dispatching select statements.
if Has_Entry
or else Has_Interfaces (Protect_Rec)
or else
((Has_Attach_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp))
and then not Restriction_Active (No_Dynamic_Attachment))
then
declare
Pkg_Id : constant RTU_Id :=
Corresponding_Runtime_Package (Ptyp);
-- Protected types with interrupt handlers (when not using a
-- restricted profile) are also considered equivalent to protected
-- types with entries. The types which are used
-- (Static_Interrupt_Protection and Dynamic_Interrupt_Protection)
-- are derived from Protection_Entries.
Called_Subp : RE_Id;
declare
Pkg_Id : constant RTU_Id := Corresponding_Runtime_Package (Ptyp);
Called_Subp : RE_Id;
begin
case Pkg_Id is
when System_Tasking_Protected_Objects_Entries =>
Called_Subp := RE_Initialize_Protection_Entries;
begin
case Pkg_Id is
when System_Tasking_Protected_Objects_Entries =>
Called_Subp := RE_Initialize_Protection_Entries;
when System_Tasking_Protected_Objects =>
Called_Subp := RE_Initialize_Protection;
-- Argument Compiler_Info
when System_Tasking_Protected_Objects_Single_Entry =>
Called_Subp := RE_Initialize_Protection_Entry;
when others =>
raise Program_Error;
end case;
if Has_Entry
or else not Restricted
or else Has_Interfaces (Protect_Rec)
then
Append_To (Args,
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_uInit),
Attribute_Name => Name_Address));
end if;
-- Entry_Bodies parameter. This is a pointer to an array of
-- pointers to the entry body procedures and barrier functions
-- of the object. If the protected type has no entries this
-- object will not exist, in this case, pass a null.
when System_Tasking_Protected_Objects_Single_Entry =>
Called_Subp := RE_Initialize_Protection_Entry;
if Has_Entry then
P_Arr := Entry_Bodies_Array (Ptyp);
-- Argument Compiler_Info
Append_To (Args,
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Arr, Loc),
Prefix => Make_Identifier (Loc, Name_uInit),
Attribute_Name => Name_Address));
when System_Tasking_Protected_Objects =>
Called_Subp := RE_Initialize_Protection;
when others =>
raise Program_Error;
end case;
-- Entry_Bodies parameter. This is a pointer to an array of
-- pointers to the entry body procedures and barrier functions of
-- the object. If the protected type has no entries this object
-- will not exist, in this case, pass a null (it can happen when
-- there are protected interrupt handlers or interfaces).
if Has_Entry then
P_Arr := Entry_Bodies_Array (Ptyp);
-- Argument Entry_Body (for single entry) or Entry_Bodies (for
-- multiple entries).
Append_To (Args,
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Arr, Loc),
Attribute_Name => Name_Unrestricted_Access));
if Pkg_Id = System_Tasking_Protected_Objects_Entries then
-- Find index mapping function (clumsy but ok for now)
while Ekind (P_Arr) /= E_Function loop
Next_Entity (P_Arr);
end loop;
Append_To (Args,
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Arr, Loc),
Attribute_Name => Name_Unrestricted_Access));
if Pkg_Id = System_Tasking_Protected_Objects_Entries then
-- Find index mapping function (clumsy but ok for now)
while Ekind (P_Arr) /= E_Function loop
Next_Entity (P_Arr);
end loop;
Append_To (Args,
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Arr, Loc),
Attribute_Name => Name_Unrestricted_Access));
end if;
elsif Pkg_Id =
System_Tasking_Protected_Objects_Single_Entry
then
Append_To (Args, Make_Null (Loc));
elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
Append_To (Args, Make_Null (Loc));
Append_To (Args, Make_Null (Loc));
end if;
Append_To (L,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (Called_Subp), Loc),
Parameter_Associations => Args));
end;
else
elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry then
-- This is the case where we have a protected object with
-- interfaces and no entries, and the single entry restriction
-- is in effect. We pass a null pointer for the entry
-- parameter because there is no actual entry.
Append_To (Args, Make_Null (Loc));
elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
-- This is the case where we have a protected object with no
-- entries and:
-- - either interrupt handlers with non restricted profile,
-- - or interfaces
-- Note that the types which are used for interrupt handlers
-- (Static/Dynamic_Interrupt_Protection) are derived from
-- Protection_Entries. We pass two null pointers because there
-- is no actual entry, and the initialization procedure needs
-- both Entry_Bodies and Find_Body_Index.
Append_To (Args, Make_Null (Loc));
Append_To (Args, Make_Null (Loc));
end if;
Append_To (L,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Initialize_Protection), Loc),
Name => New_Reference_To (RTE (Called_Subp), Loc),
Parameter_Associations => Args));
end if;
end;
end if;
if Has_Attach_Handler (Ptyp) then

13
gcc/ada/exp_util.adb
View File

@ -1631,10 +1631,15 @@ package body Exp_Util is
-- node to recognize this case.
or else Present (Interface_List (Parent (Typ)))
or else
(((Has_Attach_Handler (Typ) and then not Restricted_Profile)
or else Has_Interrupt_Handler (Typ))
and then not Restriction_Active (No_Dynamic_Attachment))
-- Protected types with interrupt handlers (when not using a
-- restricted profile) are also considered equivalent to
-- protected types with entries. The types which are used
-- (Static_Interrupt_Protection and Dynamic_Interrupt_Protection)
-- are derived from Protection_Entries.
or else (Has_Attach_Handler (Typ) and then not Restricted_Profile)
or else Has_Interrupt_Handler (Typ)
then
if Abort_Allowed
or else Restriction_Active (No_Entry_Queue) = False

2
gcc/ada/gnat_rm.texi
View File

@ -8829,6 +8829,8 @@ kept in mind when considering efficiency.
The @code{Update} attribute cannot be applied to prefixes of a limited
type, and cannot reference discriminants in the case of a record type.
The accessibility level of an Update attribute result object is defined
as for an aggregate.
In the record case, no component can be mentioned more than once. In
the array case, two overlapping ranges can appear in the aggregate,

2
gcc/ada/gnat_ugn.texi
View File

@ -21738,7 +21738,7 @@ end STB;
@end smallexample
@smallexample
$ gnatmake -g .\stb -bargs -E -largs -lgnat -laddr2line -lintl
$ gnatmake -g .\stb -bargs -E
$ stb
0040149F in stb.p1 at stb.adb:8

18
gcc/ada/sem_ch13.adb
View File

@ -1593,6 +1593,18 @@ package body Sem_Ch13 is
goto Continue;
end if;
-- For case of address aspect, we don't consider that we
-- know the entity is never set in the source, since it is
-- is likely aliasing is occurring.
-- Note: one might think that the analysis of the resulting
-- attribute definition clause would take care of that, but
-- that's not the case since it won't be from source.
if A_Id = Aspect_Address then
Set_Never_Set_In_Source (E, False);
end if;
-- Construct the attribute definition clause
Aitem :=
@ -3474,7 +3486,8 @@ package body Sem_Ch13 is
-- and alignment of the overlaying variable. We defer this
-- check till after code generation to take full advantage
-- of the annotation done by the back end. This entry is
-- only made if the address clause comes from source.
-- only made if the address clause comes from source or
-- from an aspect clause (which is still from source).
-- If the entity has a generic type, the check will be
-- performed in the instance if the actual type justifies
@ -3482,7 +3495,8 @@ package body Sem_Ch13 is
-- prevent spurious warnings.
if Address_Clause_Overlay_Warnings
and then Comes_From_Source (N)
and then (Comes_From_Source (N)
or else From_Aspect_Specification (N))
and then Present (O_Ent)
and then Is_Object (O_Ent)
then

6
gcc/ada/sem_util.adb
View File

@ -8863,10 +8863,12 @@ package body Sem_Util is
when N_Function_Call =>
return Etype (N) /= Standard_Void_Type;
-- Attributes 'Input and 'Result produce objects
-- Attributes 'Input, 'Old and 'Result produce objects
when N_Attribute_Reference =>
return Nam_In (Attribute_Name (N), Name_Input, Name_Result);
return
Nam_In
(Attribute_Name (N), Name_Input, Name_Old, Name_Result);
when N_Selected_Component =>
return