Commit 69fff50e by Arnaud Charlet

[multiple changes]

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Case_Statement): If a choice is a
	subtype indication and the case statement has only two choices,
	replace subtype indication with its range, because the resulting
	membership test cannot have a subtype indication as an operand.

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch3.adb: Update comments, minor reformatting.

From-SVN: r213583
parent e85f4337
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Case_Statement): If a choice is a
subtype indication and the case statement has only two choices,
replace subtype indication with its range, because the resulting
membership test cannot have a subtype indication as an operand.
2014-08-04 Arnaud Charlet <charlet@adacore.com>
* exp_ch3.adb: Update comments, minor reformatting.
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Explain why the bodies of
......
......@@ -4570,8 +4570,8 @@ package body Exp_Ch3 is
begin
-- Expand_Record_Extension is called directly from the semantics, so
-- we must check to see whether expansion is active before proceeding
-- Because this affects the visibility of selected components in bodies
-- we must check to see whether expansion is active before proceeding,
-- because this affects the visibility of selected components in bodies
-- of instances.
if not Expander_Active then
......@@ -4686,9 +4686,7 @@ package body Exp_Ch3 is
-- record parameter for an entry declaration. No master is created
-- for such a type.
if Comes_From_Source (N)
and then Has_Task (Desig_Typ)
then
if Comes_From_Source (N) and then Has_Task (Desig_Typ) then
Build_Master_Entity (Ptr_Typ);
Build_Master_Renaming (Ptr_Typ);
......@@ -5743,8 +5741,7 @@ package body Exp_Ch3 is
-- allocated in place, delay checks until assignments are
-- made, because the discriminants are not initialized.
if Nkind (Expr) = N_Allocator
and then No_Initialization (Expr)
if Nkind (Expr) = N_Allocator and then No_Initialization (Expr)
then
null;
......@@ -7134,9 +7131,8 @@ package body Exp_Ch3 is
-- routine. There is no need to add predefined primitives of interfaces
-- because all their predefined primitives are abstract.
if Is_Tagged_Type (Def_Id)
and then not Is_Interface (Def_Id)
then
if Is_Tagged_Type (Def_Id) and then not Is_Interface (Def_Id) then
-- Do not add the body of predefined primitives in case of CPP tagged
-- type derivations that have convention CPP.
......@@ -7990,10 +7986,9 @@ package body Exp_Ch3 is
end if;
-- The final expression is obtained by doing an unchecked conversion
-- of this result to the base type of the required subtype. We use
-- the base type to prevent the unchecked conversion from chopping
-- bits, and then we set Kill_Range_Check to preserve the "bad"
-- value.
-- of this result to the base type of the required subtype. Use the
-- base type to prevent the unchecked conversion from chopping bits,
-- and then we set Kill_Range_Check to preserve the "bad" value.
Result := Unchecked_Convert_To (Base_Type (T), Val);
......
......@@ -2681,13 +2681,23 @@ package body Exp_Ch5 is
and then Attribute_Name (Choice) = Name_Range)
or else (Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice)))
or else Nkind (Choice) = N_Subtype_Indication
then
Cond :=
Make_In (Loc,
Left_Opnd => Expression (N),
Right_Opnd => Relocate_Node (Choice));
-- A subtype indication is not a legal operator in a membership
-- test, so retrieve its range.
elsif Nkind (Choice) = N_Subtype_Indication then
Cond :=
Make_In (Loc,
Left_Opnd => Expression (N),
Right_Opnd =>
Relocate_Node
(Range_Expression (Constraint (Choice))));
-- For any other subexpression "expression = value"
else
......@@ -2715,10 +2725,9 @@ package body Exp_Ch5 is
-- compute the contents of the Others_Discrete_Choices which is not
-- needed by the back end anyway.
-- The reason we do this is that the back end always needs some
-- default for a switch, so if we have not supplied one in the
-- processing above for validity checking, then we need to supply
-- one here.
-- The reason for this is that the back end always needs some default
-- for a switch, so if we have not supplied one in the processing
-- above for validity checking, then we need to supply one here.
if not Others_Present then
Others_Node := Make_Others_Choice (Sloc (Last_Alt));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment