+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
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)
-- 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;
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;
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.
-- 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,
(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,
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,
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
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.
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.
-- 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;
-- 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
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
-- 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.
projects / gcc.git / commitdiff