procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

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

	* sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
	reformatting.

2011-11-21  Arnaud Charlet  <charlet@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2011-11-21 13:05:56 +01:00
parent f460d8f397
commit 83e5da6986
6 changed files with 47 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/ada/ChangeLog
View file

@ -1,3 +1,14 @@
2011-11-21 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
reformatting.
2011-11-21 Arnaud Charlet <charlet@adacore.com>
* 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 <baird@adacore.com>
* sem_util.ads: Update comment describing function

8
gcc/ada/s-taprop-posix.adb
View file

@ -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));

8
gcc/ada/sem_attr.adb
View file

@ -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

3
gcc/ada/sem_ch3.adb
View file

@ -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);

34
gcc/ada/sem_res.adb
View file

@ -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);

4
gcc/ada/sem_util.adb
View file

@ -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;