diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 27a720e82b6..6b23472e32f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2011-11-21 Robert Dewar + + * 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 * s-taprop-irix.adb, s-taprop-solaris.adb (Create_Task): Use diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 452517617e1..8cb084d6ba2 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -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) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7d10df9015c..8b6613dfa2e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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; diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb index f6484ebd5d1..78958412ab2 100644 --- a/gcc/ada/s-stposu.adb +++ b/gcc/ada/s-stposu.adb @@ -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; diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads index 6d5298e563b..38f8cfc73a3 100644 --- a/gcc/ada/s-stposu.ads +++ b/gcc/ada/s-stposu.ads @@ -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. diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 29865f4c01a..62cb4f75e0a 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -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, diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index a5301b1f374..c98da19eb49 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -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, diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index ac8bb8344b9..c2277851bc4 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 25ee63ec29f..4a44e43c151 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 296ba040b03..ae2e089c099 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index e20dbc0a22f..56604e17079 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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.