OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, g-memdum.ads, i-cstrea.ads: Minor reformatting.

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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.

From-SVN: r212804
This commit is contained in:
Arnaud Charlet 2014-07-18 12:06:00 +02:00
parent 3b8481cb9a
commit ee4eee0a54
14 changed files with 544 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
gcc/ada/ChangeLog
View File

@ -1,3 +1,38 @@
2014-07-18 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, g-memdum.ads, i-cstrea.ads: Minor reformatting.
2014-07-18 Robert Dewar <dewar@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <quinot@adacore.com>
* g-memdum.adb, g-memdum.ads: Code clean ups.

19
gcc/ada/einfo.adb
View File

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

58
gcc/ada/einfo.ads
View File

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

11
gcc/ada/exp_ch13.adb
View File

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

146
gcc/ada/exp_ch3.adb
View File

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

12
gcc/ada/g-memdum.ads
View File

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

19
gcc/ada/i-cstrea.ads
View File

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

347
gcc/ada/sem_ch13.adb
View File

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

4
gcc/ada/sem_ch3.adb
View File

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

27
gcc/ada/sem_ch4.adb
View File

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

50
gcc/ada/sem_eval.adb
View File

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

10
gcc/ada/sem_eval.ads
View File

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

16
gcc/ada/sem_util.adb
View File

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

16
gcc/ada/sinfo.ads
View File

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