From 83e5da6986450837164975db92d7e84f8be0c096 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 21 Nov 2011 13:05:56 +0100 Subject: [PATCH] [multiple changes] 2011-11-21 Robert Dewar * sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor reformatting. 2011-11-21 Arnaud Charlet * s-taprop-posix.adb (Create_Task): Use Unrestricted_Access to deal with fact that we properly detect the error if Access is used. From-SVN: r181572 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/s-taprop-posix.adb | 8 +++++++- gcc/ada/sem_attr.adb | 8 ++++---- gcc/ada/sem_ch3.adb | 3 ++- gcc/ada/sem_res.adb | 34 +++++++++++++++++++--------------- gcc/ada/sem_util.adb | 4 ++++ 6 files changed, 47 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ad67de5d4a9..fe786073a02 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2011-11-21 Robert Dewar + + * sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor + reformatting. + +2011-11-21 Arnaud Charlet + + * s-taprop-posix.adb (Create_Task): Use Unrestricted_Access + to deal with fact that we properly detect the error if Access + is used. + 2011-11-21 Steve Baird * sem_util.ads: Update comment describing function diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index 425508a32c2..44015cf85d5 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -975,8 +975,14 @@ 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'Access, + (T.Common.LL.Thread'Unrestricted_Access, Attributes'Access, Thread_Body_Access (Wrapper), To_Address (T)); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4005ba2426a..ac8bb8344b9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -8642,10 +8642,10 @@ package body Sem_Attr is end if; end if; - -- Check the static accessibility rule of 3.10.2(28). - -- Note that this check is not performed for the - -- case of an anonymous access type, since the access - -- attribute is always legal in such a context. + -- Check the static accessibility rule of 3.10.2(28). Note that + -- this check is not performed for the case of an anonymous + -- access type, since the access attribute is always legal + -- in such a context. if Attr_Id /= Attribute_Unchecked_Access and then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3587e07685a..92e1b9da994 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1897,7 +1897,8 @@ package body Sem_Ch3 is -- components if Type_Access_Level (Etype (E)) > - Deepest_Type_Access_Level (T) then + Deepest_Type_Access_Level (T) + then Error_Msg_N ("expression has deeper access level than component " & "(RM 3.10.2 (12.2))", E); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 30421af048f..e45be653cbc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4095,10 +4095,10 @@ package body Sem_Res is -- object must not be deeper than that of the allocator's type. elsif Nkind (Disc_Exp) = N_Attribute_Reference - and then Get_Attribute_Id (Attribute_Name (Disc_Exp)) - = Attribute_Access - and then Object_Access_Level (Prefix (Disc_Exp)) - > Deepest_Type_Access_Level (Alloc_Typ) + and then Get_Attribute_Id (Attribute_Name (Disc_Exp)) = + Attribute_Access + and then Object_Access_Level (Prefix (Disc_Exp)) > + Deepest_Type_Access_Level (Alloc_Typ) then Error_Msg_N ("prefix of attribute has deeper level than allocator type", @@ -4109,8 +4109,8 @@ package body Sem_Res is elsif Ekind (Etype (Disc_Exp)) = E_Anonymous_Access_Type and then Nkind (Disc_Exp) = N_Selected_Component - and then Object_Access_Level (Prefix (Disc_Exp)) - > Deepest_Type_Access_Level (Alloc_Typ) + and then Object_Access_Level (Prefix (Disc_Exp)) > + Deepest_Type_Access_Level (Alloc_Typ) then Error_Msg_N ("access discriminant has deeper level than allocator type", @@ -4315,7 +4315,8 @@ package body Sem_Res is end if; if Type_Access_Level (Exp_Typ) > - Deepest_Type_Access_Level (Typ) then + Deepest_Type_Access_Level (Typ) + then if In_Instance_Body then Error_Msg_N ("?type in allocator has deeper level than" & " designated class-wide type", E); @@ -10359,13 +10360,15 @@ package body Sem_Res is Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type) then if Type_Access_Level (Target_Type) < - Deepest_Type_Access_Level (Opnd_Type) + Deepest_Type_Access_Level (Opnd_Type) then if In_Instance_Body then - Error_Msg_N ("?source array type " & - "has deeper accessibility level than target", Operand); - Error_Msg_N ("\?Program_Error will be raised at run time", - Operand); + Error_Msg_N + ("?source array type has " & + "deeper accessibility level than target", Operand); + Error_Msg_N + ("\?Program_Error will be raised at run time", + Operand); Rewrite (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Accessibility_Check_Failed)); @@ -10375,8 +10378,9 @@ package body Sem_Res is -- Conversion not allowed because of accessibility levels else - Error_Msg_N ("source array type " & - "has deeper accessibility level than target", Operand); + Error_Msg_N + ("source array type has " & + "deeper accessibility level than target", Operand); return False; end if; @@ -10399,7 +10403,7 @@ package body Sem_Res is -- All of this is checked in Subtypes_Statically_Match. if not Subtypes_Statically_Match - (Target_Comp_Type, Opnd_Comp_Type) + (Target_Comp_Type, Opnd_Comp_Type) then Error_Msg_N ("component subtypes must statically match", Operand); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c3fe8f9bbfa..8e6a2a2fa36 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2437,6 +2437,8 @@ package body Sem_Util is (Defining_Identifier (Associated_Node_For_Itype (Typ)))); + -- For generic formal type, return Int'Last (infinite) (why ???) + elsif Is_Generic_Type (Root_Type (Typ)) then return UI_From_Int (Int'Last); @@ -12717,6 +12719,8 @@ package body Sem_Util is end if; end if; + -- Return library level for a generic formal type (why???) + if Is_Generic_Type (Root_Type (Btyp)) then return Scope_Depth (Standard_Standard); end if; -- 2.30.2