[multiple changes]

2012-08-06  Vincent Pucci  <pucci@adacore.com>

	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
	Use of Known_Static_Esize instead of  Known_Esize and
	Known_Static_RM_Size instead of Known_RM_Size in order to
	properly call UI_To_Int. Don't check the size of the component
	type in case of generic.
	* sem_ch9.adb (Allows_Lock_Free_Implementation):
	Use of Known_Static_Esize instead of Known_Esize and
	Known_Static_RM_Size instead of Known_RM_Size in order to properly
	call UI_To_Int. Don't check the size of the component type in
	case of generic.

2012-08-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Discrete_Range_Cond): Do not try to optimize on
	the assumption that the type of an expression can always fit in
	the target type of a conversion.

From-SVN: r190156
This commit is contained in:
Arnaud Charlet 2012-08-06 09:33:43 +02:00
parent d188799da6
commit b3f96dc15b
4 changed files with 73 additions and 67 deletions

View File

@ -1,3 +1,22 @@
2012-08-06 Vincent Pucci <pucci@adacore.com>
* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body):
Use of Known_Static_Esize instead of Known_Esize and
Known_Static_RM_Size instead of Known_RM_Size in order to
properly call UI_To_Int. Don't check the size of the component
type in case of generic.
* sem_ch9.adb (Allows_Lock_Free_Implementation):
Use of Known_Static_Esize instead of Known_Esize and
Known_Static_RM_Size instead of Known_RM_Size in order to properly
call UI_To_Int. Don't check the size of the component type in
case of generic.
2012-08-06 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Discrete_Range_Cond): Do not try to optimize on
the assumption that the type of an expression can always fit in
the target type of a conversion.
2012-07-30 Robert Dewar <dewar@adacore.com>
* bindusg.adb: Clarify file in -A lines.

View File

@ -6660,12 +6660,6 @@ package body Checks is
LB := New_Occurrence_Of (Discriminal (Entity (LB)), Loc);
end if;
if Nkind (HB) = N_Identifier
and then Ekind (Entity (HB)) = E_Discriminant
then
HB := New_Occurrence_Of (Discriminal (Entity (HB)), Loc);
end if;
Left_Opnd :=
Make_Op_Lt (Loc,
Left_Opnd =>
@ -6677,28 +6671,10 @@ package body Checks is
(Base_Type (Typ),
Get_E_First_Or_Last (Loc, Typ, 0, Name_First)));
if Base_Type (Typ) = Typ then
return Left_Opnd;
elsif Compile_Time_Known_Value (High_Bound (Scalar_Range (Typ)))
and then
Compile_Time_Known_Value (High_Bound (Scalar_Range
(Base_Type (Typ))))
if Nkind (HB) = N_Identifier
and then Ekind (Entity (HB)) = E_Discriminant
then
if Is_Floating_Point_Type (Typ) then
if Expr_Value_R (High_Bound (Scalar_Range (Typ))) =
Expr_Value_R (High_Bound (Scalar_Range (Base_Type (Typ))))
then
return Left_Opnd;
end if;
else
if Expr_Value (High_Bound (Scalar_Range (Typ))) =
Expr_Value (High_Bound (Scalar_Range (Base_Type (Typ))))
then
return Left_Opnd;
end if;
end if;
HB := New_Occurrence_Of (Discriminal (Entity (HB)), Loc);
end if;
Right_Opnd :=

View File

@ -3260,14 +3260,14 @@ package body Exp_Ch9 is
begin
-- Get the type size
if Known_Esize (Comp_Type) then
if Known_Static_Esize (Comp_Type) then
Typ_Size := UI_To_Int (Esize (Comp_Type));
-- If the Esize (Object_Size) is unknown at compile-time, look at
-- the RM_Size (Value_Size) since it may have been set by an
-- explicit representation clause.
elsif Known_RM_Size (Comp_Type) then
elsif Known_Static_RM_Size (Comp_Type) then
Typ_Size := UI_To_Int (RM_Size (Comp_Type));
-- Should not happen since this has already been checked in

View File

@ -528,15 +528,17 @@ package body Sem_Ch9 is
return Abandon;
-- Quantified expression restricted
-- Quantified expression restricted. Note that we have
-- to check the original node as well, since at this
-- stage, it may have been rewritten.
elsif Kind = N_Quantified_Expression
or else Nkind (Original_Node (N)) =
N_Quantified_Expression
or else
Nkind (Original_Node (N)) = N_Quantified_Expression
then
if Lock_Free_Given then
Error_Msg_N ("quantified expression not allowed",
N);
Error_Msg_N
("quantified expression not allowed", N);
return Skip;
end if;
@ -576,46 +578,55 @@ package body Sem_Ch9 is
and then Is_List_Member (Comp_Decl)
and then List_Containing (Comp_Decl) = Priv_Decls
then
-- Make sure the protected component type has
-- size and alignment fields set at this point
-- whenever this is possible.
-- Skip generic types since, in that case, we
-- will not build a body anyway (in the generic
-- template), and the size in the template may
-- have a fake value.
Layout_Type (Comp_Type);
if not Is_Generic_Type (Comp_Type) then
-- Note that Known_Esize is used and not
-- Known_Static_Esize in order to capture the
-- errors properly at the instantiation point.
-- Make sure the protected component type has
-- size and alignment fields set at this
-- point whenever this is possible.
if Known_Esize (Comp_Type) then
Comp_Size := UI_To_Int (Esize (Comp_Type));
Layout_Type (Comp_Type);
-- If the Esize (Object_Size) is unknown at
-- compile-time, look at the RM_Size
-- (Value_Size) since it may have been set by an
-- explicit representation clause.
if Known_Static_Esize (Comp_Type) then
Comp_Size := UI_To_Int (Esize (Comp_Type));
elsif Known_RM_Size (Comp_Type) then
Comp_Size := UI_To_Int (RM_Size (Comp_Type));
-- If the Esize (Object_Size) is unknown at
-- compile-time, look at the RM_Size
-- (Value_Size) since it may have been set by
-- an explicit representation clause.
elsif Known_Static_RM_Size (Comp_Type) then
Comp_Size :=
UI_To_Int (RM_Size (Comp_Type));
-- Worrisome missing else raise PE???
end if;
-- Check that the size of the component is 8,
-- 16, 32 or 64 bits.
-- What about AAMP here???
case Comp_Size is
when 8 | 16 | 32 | 64 =>
null;
when others =>
if Lock_Free_Given then
Error_Msg_NE
("type of& must support atomic " &
"operations",
N, Comp_Id);
return Skip;
end if;
return Abandon;
end case;
end if;
-- Check that the size of the component is 8,
-- 16, 32 or 64 bits.
case Comp_Size is
when 8 | 16 | 32 | 64 =>
null;
when others =>
if Lock_Free_Given then
Error_Msg_NE
("type of& must support atomic " &
"operations",
N, Comp_Id);
return Skip;
end if;
return Abandon;
end case;
-- Check if another protected component has
-- already been accessed by the subprogram body.