diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 21 |
3 files changed, 35 insertions, 20 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d210982df14..c417df3a7af 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +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 diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5e11962325c..2f21d488dd0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 12c50a152f2..b39145c7daa 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -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)); @@ -2810,7 +2819,7 @@ package body Exp_Ch5 is I_Spec : constant Node_Id := Iterator_Specification (Isc); Element : constant Entity_Id := Defining_Identifier (I_Spec); Container : constant Node_Id := Entity (Name (I_Spec)); - Container_Typ : constant Entity_Id := Base_Type (Etype (Container)); + Container_Typ : constant Entity_Id := Base_Type (Etype (Container)); Stats : constant List_Id := Statements (N); Cursor : constant Entity_Id := |