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:
parent
cf54716442
commit
8a06151a73
|
@ -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>
|
2011-11-21 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
* s-taprop-irix.adb, s-taprop-solaris.adb (Create_Task): Use
|
* s-taprop-irix.adb, s-taprop-solaris.adb (Create_Task): Use
|
||||||
|
|
|
@ -270,10 +270,17 @@ package body Exp_Prag is
|
||||||
|
|
||||||
procedure Expand_Pragma_Check (N : Node_Id) is
|
procedure Expand_Pragma_Check (N : Node_Id) is
|
||||||
Cond : constant Node_Id := Arg2 (N);
|
Cond : constant Node_Id := Arg2 (N);
|
||||||
Loc : constant Source_Ptr := Sloc (First_Node (Cond));
|
|
||||||
Nam : constant Name_Id := Chars (Arg1 (N));
|
Nam : constant Name_Id := Chars (Arg1 (N));
|
||||||
Msg : Node_Id;
|
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
|
begin
|
||||||
-- We already know that this check is enabled, because otherwise the
|
-- We already know that this check is enabled, because otherwise the
|
||||||
-- semantic pass dealt with rewriting the assertion (see Sem_Prag)
|
-- semantic pass dealt with rewriting the assertion (see Sem_Prag)
|
||||||
|
|
|
@ -6425,6 +6425,9 @@ package body Exp_Util is
|
||||||
-- Instead, formal verification is performed only on those expressions
|
-- Instead, formal verification is performed only on those expressions
|
||||||
-- provably side-effect free.
|
-- 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
|
if not Full_Expander_Active then
|
||||||
return;
|
return;
|
||||||
|
|
||||||
|
|
|
@ -565,7 +565,7 @@ package body System.Storage_Pools.Subpools is
|
||||||
|
|
||||||
function Header_Size_With_Padding
|
function Header_Size_With_Padding
|
||||||
(Alignment : System.Storage_Elements.Storage_Count)
|
(Alignment : System.Storage_Elements.Storage_Count)
|
||||||
return System.Storage_Elements.Storage_Count
|
return System.Storage_Elements.Storage_Count
|
||||||
is
|
is
|
||||||
Size : constant Storage_Count := Header_Size;
|
Size : constant Storage_Count := Header_Size;
|
||||||
|
|
||||||
|
|
|
@ -331,7 +331,7 @@ private
|
||||||
|
|
||||||
function Header_Size_With_Padding
|
function Header_Size_With_Padding
|
||||||
(Alignment : System.Storage_Elements.Storage_Count)
|
(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
|
-- Given an arbitrary alignment, calculate the size of the header which
|
||||||
-- precedes a controlled object as the nearest multiple rounded up of the
|
-- precedes a controlled object as the nearest multiple rounded up of the
|
||||||
-- alignment.
|
-- alignment.
|
||||||
|
|
|
@ -836,6 +836,12 @@ package body System.Task_Primitives.Operations is
|
||||||
-- do not need to manipulate caller's signal mask at this point.
|
-- do not need to manipulate caller's signal mask at this point.
|
||||||
-- All tasks in RTS will have All_Tasks_Mask initially.
|
-- 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 :=
|
Result :=
|
||||||
pthread_create
|
pthread_create
|
||||||
(T.Common.LL.Thread'Unrestricted_Access,
|
(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));
|
(Attributes'Access, To_Int (T.Common.Task_Info.Scope));
|
||||||
pragma Assert (Result = 0);
|
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 :=
|
Result :=
|
||||||
pthread_create
|
pthread_create
|
||||||
(T.Common.LL.Thread'Unrestricted_Access,
|
(T.Common.LL.Thread'Unrestricted_Access,
|
||||||
|
|
|
@ -1005,6 +1005,12 @@ package body System.Task_Primitives.Operations is
|
||||||
Opts := THR_DETACHED + THR_BOUND;
|
Opts := THR_DETACHED + THR_BOUND;
|
||||||
end if;
|
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 :=
|
Result :=
|
||||||
thr_create
|
thr_create
|
||||||
(System.Null_Address,
|
(System.Null_Address,
|
||||||
|
|
|
@ -7821,14 +7821,30 @@ package body Sem_Attr is
|
||||||
T := T / 10;
|
T := T / 10;
|
||||||
end loop;
|
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
|
-- Only remaining possibility is user declared enum type
|
||||||
|
-- with normal case of Discard_Names not active.
|
||||||
|
|
||||||
else
|
else
|
||||||
pragma Assert (Is_Enumeration_Type (P_Type));
|
pragma Assert (Is_Enumeration_Type (P_Type));
|
||||||
|
|
||||||
W := 0;
|
W := 0;
|
||||||
L := First_Literal (P_Type);
|
L := First_Literal (P_Type);
|
||||||
|
|
||||||
while Present (L) loop
|
while Present (L) loop
|
||||||
|
|
||||||
-- Only pay attention to in range characters
|
-- Only pay attention to in range characters
|
||||||
|
|
|
@ -271,10 +271,10 @@ package body Sem_Ch6 is
|
||||||
Expr : constant Node_Id := Expression (N);
|
Expr : constant Node_Id := Expression (N);
|
||||||
Spec : constant Node_Id := Specification (N);
|
Spec : constant Node_Id := Specification (N);
|
||||||
|
|
||||||
Def_Id : Entity_Id;
|
Def_Id : Entity_Id;
|
||||||
pragma Unreferenced (Def_Id);
|
pragma Unreferenced (Def_Id);
|
||||||
|
|
||||||
Prev : Entity_Id;
|
Prev : Entity_Id;
|
||||||
-- If the expression is a completion, Prev is the entity whose
|
-- If the expression is a completion, Prev is the entity whose
|
||||||
-- declaration is completed. Def_Id is needed to analyze the spec.
|
-- declaration is completed. Def_Id is needed to analyze the spec.
|
||||||
|
|
||||||
|
@ -283,7 +283,6 @@ package body Sem_Ch6 is
|
||||||
New_Spec : Node_Id;
|
New_Spec : Node_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
-- This is one of the occasions on which we transform the tree during
|
-- This is one of the occasions on which we transform the tree during
|
||||||
-- semantic analysis. If this is a completion, transform the expression
|
-- semantic analysis. If this is a completion, transform the expression
|
||||||
-- function into an equivalent subprogram body, and analyze it.
|
-- 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,
|
-- If there are previous overloadable entities with the same name,
|
||||||
-- check whether any of them is completed by the expression function.
|
-- check whether any of them is completed by the expression function.
|
||||||
|
|
||||||
if Present (Prev)
|
if Present (Prev) and then Is_Overloadable (Prev) then
|
||||||
and then Is_Overloadable (Prev)
|
|
||||||
then
|
|
||||||
Def_Id := Analyze_Subprogram_Specification (Spec);
|
Def_Id := Analyze_Subprogram_Specification (Spec);
|
||||||
Prev := Find_Corresponding_Spec (N);
|
Prev := Find_Corresponding_Spec (N);
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -8668,6 +8668,14 @@ package body Sem_Res is
|
||||||
-- this by making sure that the expanded code points to
|
-- this by making sure that the expanded code points to
|
||||||
-- the Sloc of the expression, not the original pragma.
|
-- 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
|
Error_Msg_F
|
||||||
("?assertion would fail at run time!",
|
("?assertion would fail at run time!",
|
||||||
Expression
|
Expression
|
||||||
|
@ -8693,7 +8701,13 @@ package body Sem_Res is
|
||||||
and then Entity (Expr) = Standard_False
|
and then Entity (Expr) = Standard_False
|
||||||
then
|
then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
|
-- Post warning
|
||||||
|
|
||||||
else
|
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
|
Error_Msg_F
|
||||||
("?check would fail at run time!",
|
("?check would fail at run time!",
|
||||||
Expression
|
Expression
|
||||||
|
|
|
@ -760,6 +760,7 @@ package Sinfo is
|
||||||
-- renaming declaration when it is a Renaming_As_Body. The field is Empty
|
-- 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
|
-- if there is no corresponding spec, as in the case of a subprogram body
|
||||||
-- that serves as its own spec.
|
-- that serves as its own spec.
|
||||||
|
--
|
||||||
-- In Ada2012, Corresponding_Spec is set on expression functions that
|
-- In Ada2012, Corresponding_Spec is set on expression functions that
|
||||||
-- complete a subprogram declaration.
|
-- complete a subprogram declaration.
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue