diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 504e7f82b24..d6a5c0af5ee 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2014-07-18 Robert Dewar + + * sem_ch3.adb, g-memdum.ads, i-cstrea.ads: Minor reformatting. + +2014-07-18 Robert Dewar + + * einfo.adb (Has_Static_Predicate): New function. + (Set_Has_Static_Predicate): New procedure. + * einfo.ads (Has_Static_Predicate): New flag. + * sem_ch13.adb (Is_Predicate_Static): New function + (Build_Predicate_Functions): Use Is_Predicate_Static to reorganize + (Add_Call): Minor change in Sloc of generated expression + (Add_Predicates): Remove setting of Static_Pred, no longer used. + * sem_ch4.adb (Has_Static_Predicate): Removed this function, + replace by use of the entity flag Has_Static_Predicate_Aspect. + * sem_eval.adb (Eval_Static_Predicate_Check): Check real case + and issue warning that predicate is not checked for now. + * sem_eval.ads (Eval_Static_Predicate_Check): Fix comments in + spec. + * sem_util.adb (Check_Expression_Against_Static_Predicate): + Carry out check for any case where there is a static predicate, + and output appropriate message. + * sinfo.ads: Minor comment corrections. + +2014-07-18 Ed Schonberg + + * exp_ch3.adb (Expand_Freeze_Record_Type): If the type is derived + from an untagged private type whose full view is tagged, the type + is marked tagged for layout reasons, but it has no dispatch table, + so Set_All_DT_Position must not be called. + * exp_ch13.adb: If the freeze node is for a type internal to a + record declaration, as is the case for a class-wide subtype + of a parent component, the relevant scope is the scope of the + enclosing record. + 2014-07-18 Thomas Quinot * g-memdum.adb, g-memdum.ads: Code clean ups. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 34916804233..39342a1e276 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -415,7 +415,7 @@ package body Einfo is -- Has_Aliased_Components Flag135 -- No_Strict_Aliasing Flag136 -- Is_Machine_Code_Subprogram Flag137 - -- Is_Packed_Array_Impl_Type Flag138 + -- Is_Packed_Array_Impl_Type Flag138 -- Has_Biased_Representation Flag139 -- Has_Complex_Representation Flag140 @@ -559,12 +559,12 @@ package body Einfo is -- SPARK_Aux_Pragma_Inherited Flag266 -- Has_Shift_Operator Flag267 -- Is_Independent Flag268 + -- Has_Static_Predicate Flag269 -- (unused) Flag1 -- (unused) Flag2 -- (unused) Flag3 - -- (unused) Flag269 -- (unused) Flag270 -- (unused) Flag271 @@ -1719,6 +1719,12 @@ package body Einfo is return Flag211 (Id); end Has_Static_Discriminants; + function Has_Static_Predicate (Id : E) return B is + begin + pragma Assert (Is_Type (Id)); + return Flag269 (Id); + end Has_Static_Predicate; + function Has_Static_Predicate_Aspect (Id : E) return B is begin pragma Assert (Is_Type (Id)); @@ -4436,6 +4442,12 @@ package body Einfo is Set_Flag211 (Id, V); end Set_Has_Static_Discriminants; + procedure Set_Has_Static_Predicate (Id : E; V : B := True) is + begin + pragma Assert (Is_Type (Id)); + Set_Flag269 (Id, V); + end Set_Has_Static_Predicate; + procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id)); @@ -8243,6 +8255,7 @@ package body Einfo is W ("Has_Specified_Stream_Read", Flag192 (Id)); W ("Has_Specified_Stream_Write", Flag193 (Id)); W ("Has_Static_Discriminants", Flag211 (Id)); + W ("Has_Static_Predicate", Flag269 (Id)); W ("Has_Static_Predicate_Aspect", Flag259 (Id)); W ("Has_Storage_Size_Clause", Flag23 (Id)); W ("Has_Stream_Size_Clause", Flag184 (Id)); @@ -8325,7 +8338,7 @@ package body Einfo is W ("Is_Optional_Parameter", Flag134 (Id)); W ("Is_Package_Body_Entity", Flag160 (Id)); W ("Is_Packed", Flag51 (Id)); - W ("Is_Packed_Array_Impl_Type", Flag138 (Id)); + W ("Is_Packed_Array_Impl_Type", Flag138 (Id)); W ("Is_Potentially_Use_Visible", Flag9 (Id)); W ("Is_Predicate_Function", Flag255 (Id)); W ("Is_Predicate_Function_M", Flag256 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a6a41b7b424..73ec037fc80 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1511,11 +1511,18 @@ package Einfo is -- Has_Dynamic_Predicate_Aspect (Flag258) -- Defined in all types and subtypes. Set if a Dynamic_Predicate aspect --- applies to the type. Note that we can tell if a dynamic predicate is --- present by looking at Has_Predicates and Static_Predicate, but that --- could have come from a Predicate aspect or pragma, and we need to --- record the difference so that we can use the right set of check --- policies to figure out if the predicate is active. +-- was explicitly applied to the type. Generally we treat predicates as +-- static if possible, regardless of whether they are specified using +-- Predicate, Static_Predicate, or Dynamic_Predicate. And if a predicate +-- can be treated as static (i.e. its expression is predicate-static), +-- then the flag Has_Static_Predicate will be set True. But there are +-- cases where legality is affected by the presence of an explicit +-- Dynamic_Predicate aspect. For example, even if a predicate looks +-- static, you can't use it in a case statement if there is an explicit +-- Dynamic_Predicate aspect specified. So test Has_Static_Predicate if +-- you just want to know if the predicate can be evaluated statically, +-- but test Has_Dynamic_Predicate_Aspect to enforce legality rules about +-- the use of dynamic predicates. -- Has_Entries (synthesized) -- Applies to concurrent types. True if any entries are declared @@ -1870,13 +1877,23 @@ package Einfo is -- case of a variant record, the component list can be trimmed down to -- include only the components corresponding to these discriminants. +-- Has_Static_Predicate (Flag269) +-- Defined in all types and subtypes. Set if the type (which must be +-- a discrete, real, or string subtype) has a static predicate, i.e. a +-- predicate whose expression is predicate-static. This can result from +-- use of a Predicate, Static_Predicate or Dynamic_Predicate aspect. We +-- can distinguish these cases by testing Has_Static_Predicate_Aspect +-- and Has_Dynamic_Predicate_Aspect. See description of the latter flag +-- for further information on dynamic predicates which are also static. + -- Has_Static_Predicate_Aspect (Flag259) -- Defined in all types and subtypes. Set if a Static_Predicate aspect -- applies to the type. Note that we can tell if a static predicate is --- present by looking at Has_Predicates and Static_Predicate, but that --- could have come from a Predicate aspect or pragma, and we need to --- record the difference so that we can use the right set of check --- policies to figure out if the predicate is active. +-- present by looking at Has_Static_Predicate, but this could have come +-- from a Predicate aspect or pragma or even from a Dynamic_Predicate +-- aspect. When we need to know the difference (e.g. to know what set of +-- check policies apply, use this flag and Has_Dynamic_Predicate_Aspect +-- to determine which case we have. -- Has_Storage_Size_Clause (Flag23) [implementation base type only] -- Defined in task types and access types. It is set if a Storage_Size @@ -3873,15 +3890,15 @@ package Einfo is -- the corresponding parameter entities in the spec. -- Static_Predicate (List25) --- Defined in discrete types/subtypes with predicates (Has_Predicates --- set). Set if the type/subtype has a static predicate. Points to a --- list of expression and N_Range nodes that represent the predicate --- in canonical form. The canonical form has entries sorted in ascending --- order, with duplicates eliminated, and adjacent ranges coalesced, so --- that there is always a gap in the values between successive entries. --- The entries in this list are fully analyzed and typed with the base --- type of the subtype. Note that all entries are static and have values --- within the subtype range. +-- Defined in discrete types/subtypes with static predicates (with the +-- two flags Has_Predicates set and Has_Static_Predicate set). Set if the +-- type/subtype has a static predicate. Points to a list of expression +-- and N_Range nodes that represent the predicate in canonical form. The +-- canonical form has entries sorted in ascending order, with duplicates +-- eliminated, and adjacent ranges coalesced, so that there is always a +-- gap in the values between successive entries. The entries in this list +-- are fully analyzed and typed with the base type of the subtype. Note +-- that all entries are static and have values within the subtype range. -- Status_Flag_Or_Transient_Decl (Node15) -- Defined in variables and constants. Applies to objects that require @@ -5188,6 +5205,7 @@ package Einfo is -- Has_Specified_Stream_Output (Flag191) -- Has_Specified_Stream_Read (Flag192) -- Has_Specified_Stream_Write (Flag193) + -- Has_Static_Predicate (Flag269) -- Has_Static_Predicate_Aspect (Flag259) -- Has_Task (Flag30) (base type only) -- Has_Unchecked_Union (Flag123) (base type only) @@ -6540,6 +6558,7 @@ package Einfo is function Has_Specified_Stream_Read (Id : E) return B; function Has_Specified_Stream_Write (Id : E) return B; function Has_Static_Discriminants (Id : E) return B; + function Has_Static_Predicate (Id : E) return B; function Has_Static_Predicate_Aspect (Id : E) return B; function Has_Storage_Size_Clause (Id : E) return B; function Has_Stream_Size_Clause (Id : E) return B; @@ -7166,6 +7185,7 @@ package Einfo is procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True); procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True); procedure Set_Has_Static_Discriminants (Id : E; V : B := True); + procedure Set_Has_Static_Predicate (Id : E; V : B := True); procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True); procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True); procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True); @@ -7905,6 +7925,7 @@ package Einfo is pragma Inline (Has_Specified_Stream_Read); pragma Inline (Has_Specified_Stream_Write); pragma Inline (Has_Static_Discriminants); + pragma Inline (Has_Static_Predicate); pragma Inline (Has_Static_Predicate_Aspect); pragma Inline (Has_Storage_Size_Clause); pragma Inline (Has_Stream_Size_Clause); @@ -8378,6 +8399,7 @@ package Einfo is pragma Inline (Set_Has_Specified_Stream_Read); pragma Inline (Set_Has_Specified_Stream_Write); pragma Inline (Set_Has_Static_Discriminants); + pragma Inline (Set_Has_Static_Predicate); pragma Inline (Set_Has_Static_Predicate_Aspect); pragma Inline (Set_Has_Storage_Size_Clause); pragma Inline (Set_Has_Stream_Size_Clause); diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 9500a56e4de..096365ccb40 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -443,6 +443,17 @@ package body Exp_Ch13 is return; end if; + -- The entity may be a subtype declared for a constrained record + -- component, in which case the relevant scope is the scope of + -- the record. This happens for class-wide subtypes created for + -- a constrained type extension with inherited discriminants. + + if Is_Type (E_Scope) + and then Ekind (E_Scope) not in Concurrent_Kind + then + E_Scope := Scope (E_Scope); + end if; + -- Remember that we are processing a freezing entity and its freezing -- nodes. This flag (non-zero = set) is used to avoid the need of -- climbing through the tree while processing the freezing actions (ie. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index ad35335e940..b24a20439c3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1356,7 +1356,7 @@ package body Exp_Ch3 is elsif Is_Scalar_Type (Component_Type (Etype (Comp))) and then - (not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type)) + (not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type)) or else not Compile_Time_Known_Value (Type_High_Bound (Comp_Type))) then @@ -1620,7 +1620,7 @@ package body Exp_Ch3 is -- to the appropriate formal parameter. if Nkind (Arg) = N_Identifier - and then Ekind (Entity (Arg)) = E_Discriminant + and then Ekind (Entity (Arg)) = E_Discriminant then Arg := New_Occurrence_Of (Discriminal (Entity (Arg)), Loc); @@ -2042,7 +2042,7 @@ package body Exp_Ch3 is -- Append it to the list if Nkind (Arg) = N_Identifier - and then Ekind (Entity (Arg)) = E_Discriminant + and then Ekind (Entity (Arg)) = E_Discriminant then Append_To (Args, New_Occurrence_Of (Discriminal (Entity (Arg)), Loc)); @@ -2530,8 +2530,8 @@ package body Exp_Ch3 is Ins_Nod := First (Body_Stmts); while Present (Next (Ins_Nod)) - and then (Nkind (Ins_Nod) /= N_Procedure_Call_Statement - or else not Is_Init_Proc (Name (Ins_Nod))) + and then (Nkind (Ins_Nod) /= N_Procedure_Call_Statement + or else not Is_Init_Proc (Name (Ins_Nod))) loop Next (Ins_Nod); end loop; @@ -3421,7 +3421,7 @@ package body Exp_Ch3 is return False; elsif (Has_Discriminants (Rec_Id) - and then not Is_Unchecked_Union (Rec_Id)) + and then not Is_Unchecked_Union (Rec_Id)) or else Is_Tagged_Type (Rec_Id) or else Is_Concurrent_Record_Type (Rec_Id) or else Has_Task (Rec_Id) @@ -3595,9 +3595,7 @@ package body Exp_Ch3 is Typ : constant Entity_Id := Etype (Comp); begin - if Is_Array_Type (Typ) - and then Is_Itype (Typ) - then + if Is_Array_Type (Typ) and then Is_Itype (Typ) then Ref := Make_Itype_Reference (Loc); Set_Itype (Ref, Typ); Append_Freeze_Action (Rec_Type, Ref); @@ -3624,9 +3622,7 @@ package body Exp_Ch3 is -- The aggregate may have been rewritten as a Raise node, in which -- case there are no relevant itypes. - if Present (Agg) - and then Nkind (Agg) = N_Aggregate - then + if Present (Agg) and then Nkind (Agg) = N_Aggregate then Set_Static_Initialization (Proc_Id, Agg); declare @@ -5045,8 +5041,8 @@ package body Exp_Ch3 is and then Is_Library_Level_Entity (Def_Id) and then Is_Library_Level_Tagged_Type (Base_Typ) and then (Ekind (Base_Typ) = E_Record_Type - or else Ekind (Base_Typ) = E_Protected_Type - or else Ekind (Base_Typ) = E_Task_Type) + or else Ekind (Base_Typ) = E_Protected_Type + or else Ekind (Base_Typ) = E_Task_Type) and then not Has_Dispatch_Table (Base_Typ) then declare @@ -5186,17 +5182,17 @@ package body Exp_Ch3 is if Has_Non_Null_Base_Init_Proc (Typ) - -- Suppress call if No_Initialization set on declaration + -- Suppress call if No_Initialization set on declaration - and then not No_Initialization (N) + and then not No_Initialization (N) - -- Suppress call for special case of value type for VM + -- Suppress call for special case of value type for VM - and then not Is_Value_Type (Typ) + and then not Is_Value_Type (Typ) - -- Suppress call if initialization suppressed for the type + -- Suppress call if initialization suppressed for the type - and then not Initialization_Suppressed (Typ) + and then not Initialization_Suppressed (Typ) then -- Return without initializing when No_Default_Initialization -- applies. Note that the actual restriction check occurs later, @@ -5346,8 +5342,7 @@ package body Exp_Ch3 is and then not (Nkind (Obj_Def) = N_Identifier - and then - Present (Equivalent_Type (Entity (Obj_Def)))) + and then Present (Equivalent_Type (Entity (Obj_Def)))) then pragma Assert (Is_Class_Wide_Type (Typ)); @@ -5357,9 +5352,7 @@ package body Exp_Ch3 is -- case, the expansion of the return statement will take care of -- creating the object (via allocator) and initializing it. - if Is_Return_Object (Def_Id) - and then Is_Limited_View (Typ) - then + if Is_Return_Object (Def_Id) and then Is_Limited_View (Typ) then null; elsif Tagged_Type_Expansion then @@ -5417,24 +5410,23 @@ package body Exp_Ch3 is and then Interface_Present_In_Ancestor (Expr_Typ, Typ) and then (Expr_Typ = Etype (Expr_Typ) or else not - Is_Variable_Size_Record (Etype (Expr_Typ))) + Is_Variable_Size_Record (Etype (Expr_Typ))) then -- Copy the object Insert_Action (N, Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Object_Definition => + Object_Definition => New_Occurrence_Of (Expr_Typ, Loc), - Expression => - Relocate_Node (Expr_N))); + Expression => Relocate_Node (Expr_N))); -- Statically reference the tag associated with the -- interface Tag_Comp := Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Obj_Id, Loc), + Prefix => New_Occurrence_Of (Obj_Id, Loc), Selector_Name => New_Occurrence_Of (Find_Interface_Tag (Expr_Typ, Iface), Loc)); @@ -5747,10 +5739,10 @@ package body Exp_Ch3 is -- is too much trouble ??? if (Is_Possibly_Unaligned_Slice (Expr) - or else (Is_Possibly_Unaligned_Object (Expr) - and then not Represented_As_Scalar (Etype (Expr)))) + or else (Is_Possibly_Unaligned_Object (Expr) + and then not Represented_As_Scalar (Etype (Expr)))) and then not (Is_Array_Type (Etype (Expr)) - and then not Is_Constrained (Etype (Expr))) + and then not Is_Constrained (Etype (Expr))) then declare Stat : constant Node_Id := @@ -6053,9 +6045,9 @@ package body Exp_Ch3 is if Is_Itype (Base) and then Nkind (Associated_Node_For_Itype (Base)) = N_Object_Declaration - and then (Present (Expression (Associated_Node_For_Itype (Base))) - or else - No_Initialization (Associated_Node_For_Itype (Base))) + and then + (Present (Expression (Associated_Node_For_Itype (Base))) + or else No_Initialization (Associated_Node_For_Itype (Base))) then null; @@ -6064,7 +6056,7 @@ package body Exp_Ch3 is -- initialize scalars mode, and these types are treated specially -- and do not need initialization procedures. - elsif Root_Type (Base) = Standard_String + elsif Root_Type (Base) = Standard_String or else Root_Type (Base) = Standard_Wide_String or else Root_Type (Base) = Standard_Wide_Wide_String then @@ -6108,7 +6100,7 @@ package body Exp_Ch3 is -- Normalize_Scalars and there better be a public Init_Proc for it. elsif (Present (Init_Proc (Component_Type (Base))) - and then No (Base_Init_Proc (Base))) + and then No (Base_Init_Proc (Base))) or else (Init_Or_Norm_Scalars and then Base = Typ) or else Is_Public (Typ) then @@ -6765,6 +6757,16 @@ package body Exp_Ch3 is or else Is_Tagged_Type (Etype (Def_Id)) then Set_All_DT_Position (Def_Id); + + -- If this is a type derived from an untagged private type whose + -- full view is tagged, the type is marked tagged for layout + -- reasons, but it has no dispatch table. + + elsif Is_Derived_Type (Def_Id) + and then Is_Private_Type (Etype (Def_Id)) + and then not Is_Tagged_Type (Etype (Def_Id)) + then + return; end if; -- Create and decorate the tags. Suppress their creation when @@ -6925,16 +6927,16 @@ package body Exp_Ch3 is 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. + -- Do not add the body of predefined primitives in case of CPP tagged + -- type derivations that have convention CPP. if Is_CPP_Class (Root_Type (Def_Id)) and then Convention (Def_Id) = Convention_CPP then null; - -- Do not add the body of predefined primitives in case of - -- CIL and Java tagged types. + -- Do not add the body of predefined primitives in case of CIL and + -- Java tagged types. elsif Convention (Def_Id) = Convention_CIL or else Convention (Def_Id) = Convention_Java @@ -7087,8 +7089,8 @@ package body Exp_Ch3 is end; end if; - -- Check whether individual components have a defined invariant, - -- and add the corresponding component invariant checks. + -- Check whether individual components have a defined invariant, and add + -- the corresponding component invariant checks. Insert_Component_Invariant_Checks (N, Def_Id, Build_Record_Invariant_Proc (Def_Id, N)); @@ -7569,16 +7571,16 @@ package body Exp_Ch3 is -- Start of processing for Get_Simple_Init_Val begin - -- For a private type, we should always have an underlying type - -- (because this was already checked in Needs_Simple_Initialization). - -- What we do is to get the value for the underlying type and then do - -- an Unchecked_Convert to the private type. + -- For a private type, we should always have an underlying type (because + -- this was already checked in Needs_Simple_Initialization). What we do + -- is to get the value for the underlying type and then do an unchecked + -- conversion to the private type. if Is_Private_Type (T) then Val := Get_Simple_Init_Val (Underlying_Type (T), N, Size); -- A special case, if the underlying value is null, then qualify it - -- with the underlying type, so that the null is properly typed + -- with the underlying type, so that the null is properly typed. -- Similarly, if it is an aggregate it must be qualified, because an -- unchecked conversion does not provide a context for it. @@ -7603,7 +7605,7 @@ package body Exp_Ch3 is return Result; -- Scalars with Default_Value aspect. The first subtype may now be - -- private, so retrieve value from underlying type. + -- private, so retrieve value from underlying type. elsif Is_Scalar_Type (T) and then Has_Default_Aspect (T) then if Is_Private_Type (First_Subtype (T)) then @@ -7841,9 +7843,10 @@ package body Exp_Ch3 is else return First_Rep_Item (T) /= First_Rep_Item (Root_Type (T)); - -- May need a more precise check here: the First_Rep_Item may - -- be a stream attribute, which does not affect the representation - -- of the type ??? + -- May need a more precise check here: the First_Rep_Item may be a + -- stream attribute, which does not affect the representation of the + -- type ??? + end if; end Has_New_Non_Standard_Rep; @@ -7955,7 +7958,7 @@ package body Exp_Ch3 is if Ekind (Comp) = E_Discriminant or else (Nkind (Parent (Comp)) = N_Component_Declaration - and then Present (Expression (Parent (Comp)))) + and then Present (Expression (Parent (Comp)))) then Warning_Needed := True; exit; @@ -7988,10 +7991,10 @@ package body Exp_Ch3 is Formals : List_Id; begin - -- First parameter is always _Init : in out typ. Note that we need - -- this to be in/out because in the case of the task record value, - -- there are default record fields (_Priority, _Size, -Task_Info) - -- that may be referenced in the generated initialization routine. + -- First parameter is always _Init : in out typ. Note that we need this + -- to be in/out because in the case of the task record value, there + -- are default record fields (_Priority, _Size, -Task_Info) that may + -- be referenced in the generated initialization routine. Formals := New_List ( Make_Parameter_Specification (Loc, @@ -8085,8 +8088,7 @@ package body Exp_Ch3 is Offset_To_Top_Comp : Entity_Id := Empty; begin - -- Initialize the pointer to the secondary DT associated with the - -- interface. + -- Initialize pointer to secondary DT associated with the interface if not Is_Ancestor (Iface, Typ, Use_Full_View => True) then Append_To (Stmts_List, @@ -8157,8 +8159,8 @@ package body Exp_Ch3 is (DT_Offset_To_Top_Func (Tag_Comp), Loc), Attribute_Name => Name_Address))))); - -- In this case the next component stores the value of the - -- offset to the top. + -- In this case the next component stores the value of the offset + -- to the top. Offset_To_Top_Comp := Next_Entity (Tag_Comp); pragma Assert (Present (Offset_To_Top_Comp)); @@ -8304,11 +8306,11 @@ package body Exp_Ch3 is then exit when (Is_Record_Type (Comp_Typ) - and then Is_Variable_Size_Record - (Base_Type (Comp_Typ))) + and then Is_Variable_Size_Record + (Base_Type (Comp_Typ))) or else (Is_Array_Type (Comp_Typ) - and then Is_Variable_Size_Array (Comp_Typ)); + and then Is_Variable_Size_Array (Comp_Typ)); end if; Next_Entity (Comp); @@ -8892,9 +8894,7 @@ package body Exp_Ch3 is while Present (Elmt) loop Prim := Node (Elmt); - if Is_User_Defined_Equality (Prim) - and then No (Alias (Prim)) - then + if Is_User_Defined_Equality (Prim) and then No (Alias (Prim)) then if No (Renaming_Prim) then pragma Assert (No (Eq_Prim)); Eq_Prim := Prim; @@ -9489,9 +9489,9 @@ package body Exp_Ch3 is elsif Consider_IS_NS and then - (Root_Type (T) = Standard_String - or else Root_Type (T) = Standard_Wide_String - or else Root_Type (T) = Standard_Wide_Wide_String) + (Root_Type (T) = Standard_String or else + Root_Type (T) = Standard_Wide_String or else + Root_Type (T) = Standard_Wide_Wide_String) and then (not Is_Itype (T) or else Nkind (Associated_Node_For_Itype (T)) /= N_Aggregate) @@ -9971,9 +9971,7 @@ package body Exp_Ch3 is -- attribute has been specified or Write (resp. Read) is available for -- an ancestor type. The last condition only applies under Ada 2005. - if Is_Limited_Type (Typ) - and then Is_Tagged_Type (Typ) - then + if Is_Limited_Type (Typ) and then Is_Tagged_Type (Typ) then if Operation = TSS_Stream_Read then Has_Predefined_Or_Specified_Stream_Attribute := Has_Specified_Stream_Read (Typ); diff --git a/gcc/ada/g-memdum.ads b/gcc/ada/g-memdum.ads index 7f9951b1e06..0d56e2189e9 100644 --- a/gcc/ada/g-memdum.ads +++ b/gcc/ada/g-memdum.ads @@ -49,9 +49,9 @@ package GNAT.Memory_Dump is -- like the AAMP, where the storage unit is not 8 bits). The output is one -- or more lines in the following format, which is for the case of 32-bit -- addresses (64-bit addresses are handled appropriately): - + -- -- 0234_3368: 66 67 68 . . . 73 74 75 "fghijklmnopqstuv" - + -- -- All but the last line have 16 bytes. A question mark is used in the -- string data to indicate a non-printable character. @@ -63,15 +63,15 @@ package GNAT.Memory_Dump is -- If Prefix is set to Absolute_Address, the output is identical to the -- above version, each line starting with the absolute address of the -- first dumped storage element. - + -- -- If Prefix is set to Offset, then instead each line starts with the -- indication of the offset relative to Addr: - + -- -- 00: 66 67 68 . . . 73 74 75 "fghijklmnopqstuv" - + -- -- Finally if Prefix is set to None, the prefix is suppressed altogether, -- and only the memory contents are displayed: - + -- -- 66 67 68 . . . 73 74 75 "fghijklmnopqstuv" end GNAT.Memory_Dump; diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index dc337878031..ed2a5593ade 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -221,21 +221,18 @@ package Interfaces.C_Streams is -- Control of Text/Binary Mode -- --------------------------------- - -- If text_translation_required is true, then the following functions may - -- be used to dynamically switch a file from binary to text mode or vice - -- versa. These functions have no effect if text_translation_required is - -- false (i.e. in normal unix mode). Use fileno to get a stream handle. - procedure set_binary_mode (handle : int); procedure set_text_mode (handle : int); - - -- set_wide_text_mode is as set_text_mode but switches the translation to - -- 16-bit wide-character instead of 8-bit character. Again, this routine - -- has no effect if text_translation_required is false. On Windows this - -- is used to have proper 16-bit wide-string output on the console for - -- example. + -- If text_translation_required is true, then these two functions may + -- be used to dynamically switch a file from binary to text mode or vice + -- versa. These functions have no effect if text_translation_required is + -- false (e.g. in normal unix mode). Use fileno to get a stream handle. procedure set_wide_text_mode (handle : int); + -- This is similar to set_text_mode but switches the translation to 16-bit + -- wide-character instead of 8-bit character. Again, this routine has no + -- effect if text_translation_required is false. On Windows this is used + -- to have proper 16-bit wide-string output on the console for example. ---------------------------- -- Full Path Name support -- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 335e4f41bbf..de0fe2c1f84 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -134,6 +134,34 @@ package body Sem_Ch13 is -- that do not specify a representation characteristic are operational -- attributes. + function Is_Predicate_Static + (Expr : Node_Id; + Nam : Name_Id) return Boolean; + -- Given predicate expression Expr, tests if Expr is predicate-static in + -- the sense of the rules in (RM 3.2.4 (15-24)). Occurrences of the type + -- name in the predicate expression have been replaced by references to + -- an identifier whose Chars field is Nam. This name is unique, so any + -- identifier with Chars matching Nam must be a reference to the type. + -- Returns True if the expression is predicate-static and False otherwise, + -- but is not in the business of setting flags or issuing error messages. + -- + -- Only scalar types can have static predicates, so False is always + -- returned for non-scalar types. + -- + -- Note: the RM seems to suggest that string types can also have static + -- predicates. But that really makes lttle sense as very few useful + -- predicates can be constructed for strings. Remember that: + -- + -- "ABC" < "DEF" + -- + -- is not a static expression. So even though the clearly faulty RM wording + -- allows the following: + -- + -- subtype S is String with Static_Predicate => S < "DEF" + -- + -- We can't allow this, otherwise we have predicate-static applying to a + -- larger class than static expressions, which was never intended. + procedure New_Stream_Subprogram (N : Node_Id; Ent : Entity_Id; @@ -7509,9 +7537,6 @@ package body Sem_Ch13 is Raise_Expression_Present : Boolean := False; -- Set True if Expr has at least one Raise_Expression - Static_Predic : Node_Id := Empty; - -- Set to N_Pragma node for a static predicate if one is encountered - procedure Add_Call (T : Entity_Id); -- Includes a call to the predicate function for type T in Expr if T -- has predicates and Predicate_Function (T) is non-empty. @@ -7557,9 +7582,10 @@ package body Sem_Ch13 is if No (Expr) then Expr := Exp; + else Expr := - Make_And_Then (Loc, + Make_And_Then (Sloc (Expr), Left_Opnd => Relocate_Node (Expr), Right_Opnd => Exp); end if; @@ -7630,16 +7656,6 @@ package body Sem_Ch13 is if Nkind (Ritem) = N_Pragma and then Pragma_Name (Ritem) = Name_Predicate then - -- Save the static predicate of the type for diagnostics and - -- error reporting purposes. - - if Present (Corresponding_Aspect (Ritem)) - and then Chars (Identifier (Corresponding_Aspect (Ritem))) = - Name_Static_Predicate - then - Static_Predic := Ritem; - end if; - -- Acquire arguments Arg1 := First (Pragma_Argument_Associations (Ritem)); @@ -7963,51 +7979,80 @@ package body Sem_Ch13 is end; end if; - if Is_Discrete_Type (Typ) then + -- See if we have a static predicate. Note that the answer may be + -- yes even if we have an explicit Dynamic_Predicate present. - -- Attempt to build a static predicate for a discrete subtype. - -- This action may fail because the actual expression may not be - -- static. Note that the presence of an inherited or explicitly - -- declared dynamic predicate is orthogonal to this check because - -- we are only interested in the static predicate. + declare + PS : constant Boolean := Is_Predicate_Static (Expr, Object_Name); + EN : Node_Id; - Build_Discrete_Static_Predicate (Typ, Expr, Object_Name); + begin + -- Case where we have a predicate static aspect - -- Emit an error when the predicate is categorized as static - -- but its expression is dynamic. + if PS then - if Present (Static_Predic) - and then No (Static_Predicate (Typ)) - then - Error_Msg_F - ("expression does not have required form for " - & "static predicate", - Next (First (Pragma_Argument_Associations - (Static_Predic)))); - end if; + -- We don't set Has_Static_Predicate_Aspect, since we can have + -- any of the three cases (Predicate, Dynamic_Predicate, or + -- Static_Predicate) generating a predicate with an expression + -- that is predicate static. We just indicate that we have a + -- predicate that can be treated as static. - -- If a static predicate applies on other types, that's an error: - -- either the type is scalar but non-static, or it's not even a - -- scalar type. We do not issue an error on generated types, as - -- these may be duplicates of the same error on a source type. + Set_Has_Static_Predicate (Typ); - elsif Present (Static_Predic) and then Comes_From_Source (Typ) then - if Is_Real_Type (Typ) then - Error_Msg_FE - ("static predicates not implemented for real type&", - Typ, Typ); + -- For discrete subtype, build the static predicate list - elsif Is_Scalar_Type (Typ) then - Error_Msg_FE - ("static predicate not allowed for non-static type&", - Typ, Typ); + if Is_Discrete_Type (Typ) then + Build_Discrete_Static_Predicate (Typ, Expr, Object_Name); + + -- If we don't get a static predicate list, it means that we + -- have a case where this is not possible, most typically in + -- the case where we inherit a dynamic predicate. We do not + -- consider this an error, we just leave the predicate as + -- dynamic. But if we do succeed in building the list, then + -- we mark the predicate as static. + + if No (Static_Predicate (Typ)) then + Set_Has_Static_Predicate (Typ, False); + end if; + end if; + + -- Case of dynamic predicate (expression is not predicate-static) else - Error_Msg_FE - ("static predicate not allowed for non-scalar type&", - Typ, Typ); + -- Again, we don't set Has_Dynamic_Predicate_Aspect, since that + -- is only set if we have an explicit Dynamic_Predicate aspect + -- given. Here we may simply have a Predicate aspect where the + -- expression happens not to be predicate-static. + + -- Emit an error when the predicate is categorized as static + -- but its expression is not predicate-static. + + -- First a little fiddling to get a nice location for the + -- message. If the expression is of the form (A and then B), + -- then use the left operand for the Sloc. This avoids getting + -- confused by a call to a higher level predicate with a less + -- convenient source location. + + EN := Expr; + while Nkind (EN) = N_And_Then loop + EN := Left_Opnd (EN); + end loop; + + -- Now post appropriate message + + if Has_Static_Predicate_Aspect (Typ) then + if Is_Scalar_Type (Typ) then + Error_Msg_F + ("expression is not predicate-static (RM 4.3.2(16-22))", + EN); + else + Error_Msg_FE + ("static predicate not allowed for non-scalar type&", + EN, Typ); + end if; + end if; end if; - end if; + end; end if; end Build_Predicate_Functions; @@ -10293,6 +10338,210 @@ package body Sem_Ch13 is end if; end Is_Operational_Item; + ------------------------- + -- Is_Predicate_Static -- + ------------------------- + + function Is_Predicate_Static + (Expr : Node_Id; + Nam : Name_Id) return Boolean + is + function All_Static_Case_Alternatives (L : List_Id) return Boolean; + -- Given a list of case expression alternatives, returns True if + -- all the alternative are static (have all static choices, and a + -- static expression). + + function All_Static_Choices (L : List_Id) return Boolean; + -- Returns true if all elements of the list are ok static choices + -- as defined below for Is_Static_Choice. Used for case expression + -- alternatives and for the right operand of a membership test. + + function Is_Static_Choice (N : Node_Id) return Boolean; + -- Returns True if N represents a static choice (static subtype, or + -- static subtype indication, or static expression or static range). + -- + -- Note that this is a bit more inclusive than we actually need + -- (in particular membership tests do not allow the use of subtype + -- indications. But that doesn't matter, we have already checked + -- that the construct is legal to get this far. + + function Is_Type_Ref (N : Node_Id) return Boolean; + pragma Inline (Is_Type_Ref); + -- Returns if True if N is a reference to the type for the predicate in + -- the expression (i.e. if it is an identifier whose Chars field matches + -- the Nam given in the call). N must not be parenthesized, if the type + -- name appears in parens, this routine will return False. + + ---------------------------------- + -- All_Static_Case_Alternatives -- + ---------------------------------- + + function All_Static_Case_Alternatives (L : List_Id) return Boolean is + N : Node_Id; + + begin + N := First (L); + while Present (N) loop + if not (All_Static_Choices (Discrete_Choices (N)) + and then Is_OK_Static_Expression (Expression (N))) + then + return False; + end if; + + Next (N); + end loop; + + return True; + end All_Static_Case_Alternatives; + + ------------------------ + -- All_Static_Choices -- + ------------------------ + + function All_Static_Choices (L : List_Id) return Boolean is + N : Node_Id; + + begin + N := First (L); + while Present (N) loop + if not Is_Static_Choice (N) then + return False; + end if; + + Next (N); + end loop; + + return True; + end All_Static_Choices; + + ---------------------- + -- Is_Static_Choice -- + ---------------------- + + function Is_Static_Choice (N : Node_Id) return Boolean is + begin + return Is_OK_Static_Expression (N) + or else (Is_Entity_Name (N) and then Is_Type (Entity (N)) + and then Is_OK_Static_Subtype (Entity (N))) + or else (Nkind (N) = N_Subtype_Indication + and then Is_OK_Static_Subtype (Entity (N))) + or else (Nkind (N) = N_Range and then Is_OK_Static_Range (N)); + end Is_Static_Choice; + + ----------------- + -- Is_Type_Ref -- + ----------------- + + function Is_Type_Ref (N : Node_Id) return Boolean is + begin + return Nkind (N) = N_Identifier + and then Chars (N) = Nam + and then Paren_Count (N) = 0; + end Is_Type_Ref; + + -- Start of processing for Is_Predicate_Static + + begin + -- Only scalar types can be predicate static + + if not Is_Scalar_Type (Etype (Expr)) then + return False; + end if; + + -- Predicate_Static means one of the following holds. Numbers are the + -- corresponding paragraph numbers in (RM 3.2.4(16-22)). + + -- 16: A static expression + + if Is_OK_Static_Expression (Expr) then + return True; + + -- 17: A membership test whose simple_expression is the current + -- instance, and whose membership_choice_list meets the requirements + -- for a static membership test. + + elsif Nkind (Expr) in N_Membership_Test + and then ((Present (Right_Opnd (Expr)) + and then Is_Static_Choice (Right_Opnd (Expr))) + or else + (Present (Alternatives (Expr)) + and then All_Static_Choices (Alternatives (Expr)))) + then + return True; + + -- 18. A case_expression whose selecting_expression is the current + -- instance, and whose dependent expressions are static expressions. + + elsif Nkind (Expr) = N_Case_Expression + and then Is_Type_Ref (Expression (Expr)) + and then All_Static_Case_Alternatives (Alternatives (Expr)) + then + return True; + + -- 19. A call to a predefined equality or ordering operator, where one + -- operand is the current instance, and the other is a static + -- expression. + + elsif Nkind (Expr) in N_Op_Compare + and then ((Is_Type_Ref (Left_Opnd (Expr)) + and then Is_OK_Static_Expression (Right_Opnd (Expr))) + or else + (Is_Type_Ref (Right_Opnd (Expr)) + and then Is_OK_Static_Expression (Left_Opnd (Expr)))) + then + return True; + + -- 20. A call to a predefined boolean logical operator, where each + -- operand is predicate-static. + + elsif (Nkind_In (Expr, N_Op_And, N_Op_Or, N_Op_Xor) + and then Is_Predicate_Static (Left_Opnd (Expr), Nam) + and then Is_Predicate_Static (Right_Opnd (Expr), Nam)) + or else + (Nkind (Expr) = N_Op_Not + and then Is_Predicate_Static (Right_Opnd (Expr), Nam)) + then + return True; + + -- 21. A short-circuit control form where both operands are + -- predicate-static. + + elsif Nkind (Expr) in N_Short_Circuit + and then Is_Predicate_Static (Left_Opnd (Expr), Nam) + and then Is_Predicate_Static (Right_Opnd (Expr), Nam) + then + return True; + + -- 22. A parenthesized predicate-static expression. This does not + -- require any special test, since we just ignore paren levels in + -- all the cases above. + + -- One more test that is an implementation artifact caused by the fact + -- that we are analyzing not the original expresesion, but the generated + -- expression in the body of the predicate function. This can include + -- refereces to inherited predicates, so that the expression we are + -- processing looks like: + + -- expression and then xxPredicate (typ (Inns)) + + -- Where the call is to a Predicate function for an inherited predicate. + -- We simply ignore such a call (which could be to either a dynamic or + -- a static predicate, but remember that we can have Static_Predicate + -- for a non-static subtype). + + elsif Nkind (Expr) = N_Function_Call + and then Is_Predicate_Function (Entity (Name (Expr))) + then + return True; + + -- That's an exhaustive list of tests, all other cases are not + -- predicate static, so we return False. + + else + return False; + end if; + end Is_Predicate_Static; + --------------------- -- Kill_Rep_Clause -- --------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b18d66891a5..1f89f2e9b9e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13618,8 +13618,8 @@ package body Sem_Ch3 is Base_Type (Full_View (Id_Type)) = Base_Type (Parent_Type)) or else (Ada_Version >= Ada_2012 - and then Ekind (Id_Type) = E_Incomplete_Type - and then Full_View (Id_Type) = Parent_Type) + and then Ekind (Id_Type) = E_Incomplete_Type + and then Full_View (Id_Type) = Parent_Type) then -- Constraint checks on formals are generated during expansion, -- based on the signature of the original subprogram. The bounds diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ab7a10de09e..3dc457d5956 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1331,9 +1331,6 @@ package body Sem_Ch4 is ----------------------------- procedure Analyze_Case_Expression (N : Node_Id) is - function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean; - -- Determine whether subtype Subtyp has aspect Static_Predicate - procedure Non_Static_Choice_Error (Choice : Node_Id); -- Error routine invoked by the generic instantiation below when -- the case expression has a non static choice. @@ -1350,28 +1347,6 @@ package body Sem_Ch4 is Process_Associated_Node => No_OP); use Case_Choices_Checking; - -------------------------- - -- Has_Static_Predicate -- - -------------------------- - - function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean is - Item : Node_Id; - - begin - Item := First_Rep_Item (Subtyp); - while Present (Item) loop - if Nkind (Item) = N_Aspect_Specification - and then Chars (Identifier (Item)) = Name_Static_Predicate - then - return True; - end if; - - Next_Rep_Item (Item); - end loop; - - return False; - end Has_Static_Predicate; - ----------------------------- -- Non_Static_Choice_Error -- ----------------------------- @@ -1493,7 +1468,7 @@ package body Sem_Ch4 is -- to bogus errors. if Is_Static_Subtype (Exp_Type) - and then Has_Static_Predicate (Exp_Type) + and then Has_Static_Predicate_Aspect (Exp_Type) and then In_Spec_Expression then null; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 4ee8297530c..67e43e10424 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -3306,28 +3306,42 @@ package body Sem_Eval is Typ : Entity_Id) return Boolean is Loc : constant Source_Ptr := Sloc (N); - Pred : constant List_Id := Static_Predicate (Typ); - Test : Node_Id; begin - if No (Pred) then + -- Discrete type case + + if Is_Discrete_Type (Typ) then + declare + Pred : constant List_Id := Static_Predicate (Typ); + Test : Node_Id; + + begin + pragma Assert (Present (Pred)); + + -- The static predicate is a list of alternatives in the proper + -- format for an Ada 2012 membership test. If the argument is a + -- literal, the membership test can be evaluated statically. This + -- is easier than running a full intepretation of the predicate + -- expression, and more efficient in some cases. + + Test := + Make_In (Loc, + Left_Opnd => New_Copy_Tree (N), + Right_Opnd => Empty, + Alternatives => Pred); + Analyze_And_Resolve (Test, Standard_Boolean); + + return Nkind (Test) = N_Identifier + and then Entity (Test) = Standard_True; + end; + + -- Real type case + + else + pragma Assert (Is_Real_Type (Typ)); + Error_Msg_N ("??real predicate not applied", N); return True; end if; - - -- The static predicate is a list of alternatives in the proper format - -- for an Ada 2012 membership test. If the argument is a literal, the - -- membership test can be evaluated statically. The caller transforms - -- a result of False into a static contraint error. - - Test := - Make_In (Loc, - Left_Opnd => New_Copy_Tree (N), - Right_Opnd => Empty, - Alternatives => Pred); - Analyze_And_Resolve (Test, Standard_Boolean); - - return Nkind (Test) = N_Identifier - and then Entity (Test) = Standard_True; end Eval_Static_Predicate_Check; ------------------------- diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 7d8779d373a..461bbdbd234 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -248,7 +248,7 @@ package Sem_Eval is -- In general we take a pessimistic view. False does not mean the value -- could not be known at compile time, but True means that absolutely -- definition it is known at compile time and it is safe to call - -- Expr_Value on the expression Op. + -- Expr_Value[_XX] on the expression Op. -- -- Note that we don't define precisely the set of expressions that return -- True. Callers should not make any assumptions regarding the value that @@ -365,9 +365,11 @@ package Sem_Eval is procedure Eval_Unchecked_Conversion (N : Node_Id); function Eval_Static_Predicate_Check - (N : Node_Id; - Typ : Entity_Id) return Boolean; - -- Evaluate a static predicate check applied to a scalar literal + (N : Node_Id; + Typ : Entity_Id) return Boolean; + -- Evaluate a static predicate check applied to a known at compile time + -- value N, which can be of a discrete, real or string type. The caller + -- has checked that a static predicate does apply to Typ. procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean); -- Rewrite N with a new N_String_Literal node as the result of the compile diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d6b46c38de7..ded1d401a90 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1695,13 +1695,13 @@ package body Sem_Util is begin -- When the predicate is static and the value of the expression is known -- at compile time, evaluate the predicate check. A type is non-static - -- when it has aspect Dynamic_Predicate. + -- when it has aspect Dynamic_Predicate, but if the dynamic predicate + -- was predicate-static, we still check it statically. After all this + -- is only a warning, not an error. if Compile_Time_Known_Value (Expr) and then Has_Predicates (Typ) - and then Is_Discrete_Type (Typ) - and then Present (Static_Predicate (Typ)) - and then not Has_Dynamic_Predicate_Aspect (Typ) + and then Has_Static_Predicate (Typ) then -- Either -gnatc is enabled or the expression is ok @@ -1710,12 +1710,14 @@ package body Sem_Util is then null; - -- The expression is prohibited by the static predicate + -- The expression is prohibited by the static predicate. There has + -- been some debate if this is an illegality (in the case where + -- the static predicate was explicitly given as such), but that + -- discussion decided this was not illegal, just a warning situation. else Error_Msg_NE - ("??static expression fails static predicate check on &", - Expr, Typ); + ("??static expression fails predicate check on &", Expr, Typ); end if; end if; end Check_Expression_Against_Static_Predicate; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index d06bb4baad2..31c61e5b1b7 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4022,13 +4022,13 @@ package Sinfo is -- to deal with, and diagnose a simple expression other than a name for -- the right operand. This simplifies error recovery in the parser. - -- The Alternatives field below is present only if there is more - -- than one Membership_Choice present (which is legitimate only in - -- Ada 2012 mode) in which case Right_Opnd is Empty, and Alternatives - -- contains the list of choices. In the tree passed to the back end, - -- Alternatives is always No_List, and Right_Opnd is set (i.e. the - -- expansion circuitry expands out the complex set membership case - -- using simple membership operations). + -- The Alternatives field below is present only if there is more than + -- one Membership_Choice present (which is legitimate only in Ada 2012 + -- mode) in which case Right_Opnd is Empty, and Alternatives contains + -- the list of choices. In the tree passed to the back end, Alternatives + -- is always No_List, and Right_Opnd is set (i.e. the expansion circuit + -- expands out the complex set membership case using simple membership + -- and equality operations). -- Should we rename Alternatives here to Membership_Choices ??? @@ -4271,7 +4271,7 @@ package Sinfo is -- CASE_EXPRESSION ::= -- case SELECTING_EXPRESSION is -- CASE_EXPRESSION_ALTERNATIVE - -- {CASE_EXPRESSION_ALTERNATIVE} + -- {,CASE_EXPRESSION_ALTERNATIVE} -- Note that the Alternatives cannot include pragmas (this contrasts -- with the situation of case statements where pragmas are allowed).