Commit cf3b97ef by Arnaud Charlet

[multiple changes]

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

	* gnat_rm.texi: Library_Level attribute now applies to an
	entity name.
	* sem_attr.adb (Analyze_Attribute, case Library_Level): Prefix
	is now an entity name.

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

	* sem_ch13.adb (Analyze_Aspect_Specification): For
	Priority and CPU aspects in subprograms, the expression in the
	aspect is analyzed and exported.

From-SVN: r203543
parent 5c211bfd
2013-10-14 Robert Dewar <dewar@adacore.com> 2013-10-14 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Library_Level attribute now applies to an
entity name.
* sem_attr.adb (Analyze_Attribute, case Library_Level): Prefix
is now an entity name.
2013-10-14 Jose Ruiz <ruiz@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specification): For
Priority and CPU aspects in subprograms, the expression in the
aspect is analyzed and exported.
2013-10-14 Robert Dewar <dewar@adacore.com>
* s-valuti.adb, prep.adb, scng.adb, errout.adb: Minor reformatting. * s-valuti.adb, prep.adb, scng.adb, errout.adb: Minor reformatting.
2013-10-14 Eric Botcazou <ebotcazou@adacore.com> 2013-10-14 Eric Botcazou <ebotcazou@adacore.com>
......
...@@ -8348,21 +8348,20 @@ this attribute. ...@@ -8348,21 +8348,20 @@ this attribute.
@findex Library_Level @findex Library_Level
@noindent @noindent
@noindent @noindent
@code{Standard'Library_Level} (@code{Standard} is the only allowed @code{P'Library_Level}, where P is an entity name,
prefix) returns a Boolean value which is True if the attribute is returns a Boolean value which is True if the entity is declared
evaluated at the library level (e.g. with a package declaration), at the library level, and False otherwise. Note that within a
and false if evaluated elsewhere (e.g. within a subprogram body). generic instantition, the name of the generic unit denotes the
In the case of generics, the value indicates the placement of instance, which means that this attribute can be used to test
the instantiation, not the template, and indeed the use of this if a generic is instantiated at the library level, as shown
attribute within a generic is the intended common application in this example:
as shown in this example:
@smallexample @c ada @smallexample @c ada
generic generic
... ...
package Gen is package Gen is
pragma Compile_Time_Error pragma Compile_Time_Error
(not Standard'Library_Level, (not Gen'Library_Level,
"Gen can only be instantiated at library level"); "Gen can only be instantiated at library level");
... ...
end Gen; end Gen;
......
...@@ -3689,11 +3689,14 @@ package body Sem_Attr is ...@@ -3689,11 +3689,14 @@ package body Sem_Attr is
when Attribute_Library_Level => when Attribute_Library_Level =>
Check_E0; Check_E0;
Check_Standard_Prefix;
if not Is_Entity_Name (P) then
Error_Attr_P ("prefix of % attribute must be an entity name");
end if;
if not Inside_A_Generic then if not Inside_A_Generic then
Set_Boolean_Result (N, Set_Boolean_Result (N,
Nearest_Dynamic_Scope (Current_Scope) = Standard_Standard); Is_Library_Level_Entity (Entity (P)));
end if; end if;
Set_Etype (N, Standard_Boolean); Set_Etype (N, Standard_Boolean);
......
...@@ -1794,22 +1794,123 @@ package body Sem_Ch13 is ...@@ -1794,22 +1794,123 @@ package body Sem_Ch13 is
-- CPU, Interrupt_Priority, Priority -- CPU, Interrupt_Priority, Priority
-- These three aspects can be specified for a subprogram body, -- These three aspects can be specified for a subprogram spec
-- in which case we generate pragmas for them and insert them -- or body, in which case we analyze the expression and export
-- ahead of local declarations, rather than after the body. -- the value of the aspect.
-- Previously, we generated an equivalent pragma for bodies
-- (note that the specs cannot contain these pragmas). The
-- pragma was inserted ahead of local declarations, rather than
-- after the body. This leads to a certain duplication between
-- the processing performed for the aspect and the pragma, but
-- given the straightforward handling required it is simpler
-- to duplicate than to translate the aspect in the spec into
-- a pragma in the declarative part of the body.
when Aspect_CPU | when Aspect_CPU |
Aspect_Interrupt_Priority | Aspect_Interrupt_Priority |
Aspect_Priority => Aspect_Priority =>
if Nkind (N) = N_Subprogram_Body then if Nkind_In (N, N_Subprogram_Body,
Make_Aitem_Pragma N_Subprogram_Declaration)
(Pragma_Argument_Associations => New_List ( then
Make_Pragma_Argument_Association (Sloc (Expr), -- Analyze the aspect expression
Expression => Relocate_Node (Expr))),
Pragma_Name => Chars (Id)); Analyze_And_Resolve (Expr, Standard_Integer);
-- Interrupt_Priority aspect not allowed for main
-- subprograms. ARM D.1 does not forbid this explicitly,
-- but ARM J.15.11 (6/3) does not permit pragma
-- Interrupt_Priority for subprograms.
if A_Id = Aspect_Interrupt_Priority then
Error_Msg_N
("Interrupt_Priority aspect cannot apply to "
& "subprogram", Expr);
-- The expression must be static
elsif not Is_Static_Expression (Expr) then
Flag_Non_Static_Expr
("aspect requires static expression!", Expr);
-- Check whether this is the main subprogram
elsif Current_Sem_Unit /= Main_Unit
and then
Cunit_Entity (Current_Sem_Unit) /= Main_Unit_Entity
then
-- See ARM D.1 (14/3) and D.16 (12/3)
Error_Msg_N
("aspect applied to subprogram other than the "
& "main subprogram has no effect??", Expr);
-- Otherwise check in range and export the value
-- For the CPU aspect
elsif A_Id = Aspect_CPU then
if Is_In_Range (Expr, RTE (RE_CPU_Range)) then
-- Value is correct so we export the value to make
-- it available at execution time.
Set_Main_CPU
(Main_Unit, UI_To_Int (Expr_Value (Expr)));
else
Error_Msg_N
("main subprogram CPU is out of range", Expr);
end if;
-- For the Priority aspect
elsif A_Id = Aspect_Priority then
if Is_In_Range (Expr, RTE (RE_Priority)) then
-- Value is correct so we export the value to make
-- it available at execution time.
Set_Main_Priority
(Main_Unit, UI_To_Int (Expr_Value (Expr)));
else
Error_Msg_N
("main subprogram priority is out of range",
Expr);
end if;
end if;
-- Load an arbitrary entity from System.Tasking.Stages
-- or System.Tasking.Restricted.Stages (depending on
-- the supported profile) to make sure that one of these
-- packages is implicitly with'ed, since we need to have
-- the tasking run time active for the pragma Priority to
-- have any effect. Previously with with'ed the package
-- System.Tasking, but this package does not trigger the
-- required initialization of the run-time library.
declare
Discard : Entity_Id;
pragma Warnings (Off, Discard);
begin
if Restricted_Profile then
Discard := RTE (RE_Activate_Restricted_Tasks);
else
Discard := RTE (RE_Activate_Tasks);
end if;
end;
-- Handling for these Aspects in subprograms is complete
goto Continue;
-- For tasks
else else
-- Pass the aspect as an attribute
Aitem := Aitem :=
Make_Attribute_Definition_Clause (Loc, Make_Attribute_Definition_Clause (Loc,
Name => Ent, Name => Ent,
...@@ -2566,9 +2667,8 @@ package body Sem_Ch13 is ...@@ -2566,9 +2667,8 @@ package body Sem_Ch13 is
end if; end if;
end if; end if;
-- If the aspect is on a subprogram body (relevant aspects -- If the aspect is on a subprogram body (relevant aspect
-- are Inline and Priority), add the pragma in front of -- is Inline), add the pragma in front of the declarations.
-- the declarations.
if Nkind (N) = N_Subprogram_Body then if Nkind (N) = N_Subprogram_Body then
if No (Declarations (N)) then if No (Declarations (N)) then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment