exp_prag.adb, [...]: Minor reformatting.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* exp_prag.adb, exp_util.adb, sinfo.ads, sem_res.adb, s-stposu.adb,
	sem_attr.adb, s-stposu.ads, s-taprop-solaris.adb, s-taprop-irix.adb,
	sem_ch6.adb: Minor reformatting.

From-SVN: r181580
This commit is contained in:
Robert Dewar 2011-11-21 14:43:38 +00:00 committed by Arnaud Charlet
parent cf54716442
commit 8a06151a73
11 changed files with 72 additions and 10 deletions

View File

@ -1,3 +1,9 @@
2011-11-21 Robert Dewar <dewar@adacore.com>
* exp_prag.adb, exp_util.adb, sinfo.ads, sem_res.adb, s-stposu.adb,
sem_attr.adb, s-stposu.ads, s-taprop-solaris.adb, s-taprop-irix.adb,
sem_ch6.adb: Minor reformatting.
2011-11-21 Arnaud Charlet <charlet@adacore.com>
* s-taprop-irix.adb, s-taprop-solaris.adb (Create_Task): Use

View File

@ -270,10 +270,17 @@ package body Exp_Prag is
procedure Expand_Pragma_Check (N : Node_Id) is
Cond : constant Node_Id := Arg2 (N);
Loc : constant Source_Ptr := Sloc (First_Node (Cond));
Nam : constant Name_Id := Chars (Arg1 (N));
Msg : Node_Id;
Loc : constant Source_Ptr := Sloc (First_Node (Cond));
-- Source location used in the case of a failed assertion. Note that
-- the source location of the expression is not usually the best choice
-- here. For example, it gets located on the last AND keyword in a
-- chain of boolean expressiond AND'ed together. It is best to put the
-- message on the first character of the assertion, which is the effect
-- of the First_Node call here.
begin
-- We already know that this check is enabled, because otherwise the
-- semantic pass dealt with rewriting the assertion (see Sem_Prag)

View File

@ -6425,6 +6425,9 @@ package body Exp_Util is
-- Instead, formal verification is performed only on those expressions
-- provably side-effect free.
-- Why? Is the Alfa mode test just an optimization? Most likely not,
-- most likely it is functionally necessary, if so why ???
if not Full_Expander_Active then
return;

View File

@ -565,7 +565,7 @@ package body System.Storage_Pools.Subpools is
function Header_Size_With_Padding
(Alignment : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count
return System.Storage_Elements.Storage_Count
is
Size : constant Storage_Count := Header_Size;

View File

@ -331,7 +331,7 @@ private
function Header_Size_With_Padding
(Alignment : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count;
return System.Storage_Elements.Storage_Count;
-- Given an arbitrary alignment, calculate the size of the header which
-- precedes a controlled object as the nearest multiple rounded up of the
-- alignment.

View File

@ -836,6 +836,12 @@ package body System.Task_Primitives.Operations is
-- do not need to manipulate caller's signal mask at this point.
-- All tasks in RTS will have All_Tasks_Mask initially.
-- Note: the use of Unrestricted_Access in the following call is needed
-- because otherwise we have an error of getting a access-to-volatile
-- value which points to a non-volatile object. But in this case it is
-- safe to do this, since we know we have no problems with aliasing and
-- Unrestricted_Access bypasses this check.
Result :=
pthread_create
(T.Common.LL.Thread'Unrestricted_Access,
@ -865,6 +871,12 @@ package body System.Task_Primitives.Operations is
(Attributes'Access, To_Int (T.Common.Task_Info.Scope));
pragma Assert (Result = 0);
-- Note: the use of Unrestricted_Access in the following call
-- is needed because otherwise we have an error of getting a
-- access-to-volatile value which points to a non-volatile object.
-- But in this case it is safe to do this, since we know we have no
-- aliasing problems and Unrestricted_Access bypasses this check.
Result :=
pthread_create
(T.Common.LL.Thread'Unrestricted_Access,

View File

@ -1005,6 +1005,12 @@ package body System.Task_Primitives.Operations is
Opts := THR_DETACHED + THR_BOUND;
end if;
-- Note: the use of Unrestricted_Access in the following call is needed
-- because otherwise we have an error of getting a access-to-volatile
-- value which points to a non-volatile object. But in this case it is
-- safe to do this, since we know we have no problems with aliasing and
-- Unrestricted_Access bypasses this check.
Result :=
thr_create
(System.Null_Address,

View File

@ -7821,14 +7821,30 @@ package body Sem_Attr is
T := T / 10;
end loop;
-- User declared enum type with discard names
elsif Discard_Names (R) then
-- If range is null, result is zero, that has already
-- been dealt with, so what we need is the power of ten
-- that accomodates the Pos of the largest value, which
-- is the high bound of the range + one for the space.
W := 1;
T := Hi;
while T /= 0 loop
T := T / 10;
W := W + 1;
end loop;
-- Only remaining possibility is user declared enum type
-- with normal case of Discard_Names not active.
else
pragma Assert (Is_Enumeration_Type (P_Type));
W := 0;
L := First_Literal (P_Type);
while Present (L) loop
-- Only pay attention to in range characters

View File

@ -271,10 +271,10 @@ package body Sem_Ch6 is
Expr : constant Node_Id := Expression (N);
Spec : constant Node_Id := Specification (N);
Def_Id : Entity_Id;
Def_Id : Entity_Id;
pragma Unreferenced (Def_Id);
Prev : Entity_Id;
Prev : Entity_Id;
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed. Def_Id is needed to analyze the spec.
@ -283,7 +283,6 @@ package body Sem_Ch6 is
New_Spec : Node_Id;
begin
-- This is one of the occasions on which we transform the tree during
-- semantic analysis. If this is a completion, transform the expression
-- function into an equivalent subprogram body, and analyze it.
@ -298,9 +297,7 @@ package body Sem_Ch6 is
-- If there are previous overloadable entities with the same name,
-- check whether any of them is completed by the expression function.
if Present (Prev)
and then Is_Overloadable (Prev)
then
if Present (Prev) and then Is_Overloadable (Prev) then
Def_Id := Analyze_Subprogram_Specification (Spec);
Prev := Find_Corresponding_Spec (N);
end if;

View File

@ -8668,6 +8668,14 @@ package body Sem_Res is
-- this by making sure that the expanded code points to
-- the Sloc of the expression, not the original pragma.
-- Note: Use Error_Msg_F here rather than Error_Msg_N.
-- The source location of the expression is not usually
-- the best choice here. For example, it gets located on
-- the last AND keyword in a chain of boolean expressiond
-- AND'ed together. It is best to put the message on the
-- first character of the assertion, which is the effect
-- of the First_Node call here.
Error_Msg_F
("?assertion would fail at run time!",
Expression
@ -8693,7 +8701,13 @@ package body Sem_Res is
and then Entity (Expr) = Standard_False
then
null;
-- Post warning
else
-- Again use Error_Msg_F rather than Error_Msg_N, see
-- comment above for an explanation of why we do this.
Error_Msg_F
("?check would fail at run time!",
Expression

View File

@ -760,6 +760,7 @@ package Sinfo is
-- renaming declaration when it is a Renaming_As_Body. The field is Empty
-- if there is no corresponding spec, as in the case of a subprogram body
-- that serves as its own spec.
--
-- In Ada2012, Corresponding_Spec is set on expression functions that
-- complete a subprogram declaration.