Skip to content

R
riscv-gcc-1
Commit 8a95f4e8 by Robert Dewar Committed by Arnaud Charlet
Options

sem_intr.adb, [...]: Minor reformatting. 

2010-06-17  Robert Dewar  <dewar@adacore.com>

	* sem_intr.adb, sem_prag.adb, sem_res.adb, sem_type.adb, sem_util.adb,
	sem_warn.adb, sem_eval.adb: Minor reformatting.  Use Ekind_In.
	(Set_Slice_Subtype): Explicitly freeze the slice's itype at the point
	where the slice's actions are inserted.
	(Decompose_Expr): Account for possible rewriting of slice bounds
	resulting from side effects suppression caused by the above freezing,
	so that folding of bounds is preserved by such rewriting.

2010-06-17  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Get_Record_Representation_Clause): New function.
	* freeze.adb (Freeze_Record_Type): Add call to
	Check_Record_Representation_Clause.
	* sem_ch13.adb (Check_Record_Representation_Clause): New function
	(Analyze_Record_Representation_Clause): Split out overlap code into this
	new function.
	(Check_Component_Overlap): Moved inside
	Check_Record_Representation_Clause.
	* sem_ch13.ads (Check_Record_Representation_Clause): New function.

From-SVN: r160892
parent e1b871e9
Showing with 168 additions and 233 deletions
gcc/ada/ChangeLog
2010-06-17 Robert Dewar <dewar@adacore.com>
* sem_intr.adb, sem_prag.adb, sem_res.adb, sem_type.adb, sem_util.adb,
sem_warn.adb, sem_eval.adb: Minor reformatting. Use Ekind_In.
(Set_Slice_Subtype): Explicitly freeze the slice's itype at the point
where the slice's actions are inserted.
(Decompose_Expr): Account for possible rewriting of slice bounds
resulting from side effects suppression caused by the above freezing,
so that folding of bounds is preserved by such rewriting.
2010-06-17 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Get_Record_Representation_Clause): New function.
* freeze.adb (Freeze_Record_Type): Add call to
Check_Record_Representation_Clause.
* sem_ch13.adb (Check_Record_Representation_Clause): New function
(Analyze_Record_Representation_Clause): Split out overlap code into this
new function.
(Check_Component_Overlap): Moved inside
Check_Record_Representation_Clause.
* sem_ch13.ads (Check_Record_Representation_Clause): New function.
2010-06-17 Robert Dewar <dewar@adacore.com>
* back_end.adb, sem_res.adb, switch-c.adb, sem_scil.adb: Minor
reformatting.
* sem_attr.adb, sem_cat.adb, sem_disp.adb, sem_elab.adb, sem_elim.adb,
......
gcc/ada/einfo.adb
......@@ -5760,6 +5760,26 @@ package body Einfo is
end if;
end Get_Full_View;
--------------------------------------
-- Get_Record_Representation_Clause --
--------------------------------------
function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
N : Node_Id;
begin
N := First_Rep_Item (E);
while Present (N) loop
if Nkind (N) = N_Record_Representation_Clause then
return N;
end if;
Next_Rep_Item (N);
end loop;
return Empty;
end Get_Record_Representation_Clause;
--------------------
-- Get_Rep_Pragma --
--------------------
......
gcc/ada/einfo.ads
......@@ -6767,6 +6767,11 @@ package Einfo is
-- value returned is the N_Attribute_Definition_Clause node, otherwise
-- Empty is returned.
function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
-- Searches the Rep_Item chain for a given entyt E, for a record
-- representation clause, and if found, returns it. Returns Empty
-- if no such clause is found.
function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id;
-- Searches the Rep_Item chain for the given entity E, for an instance
-- a representation pragma with the given name Nam. If found then the
......
gcc/ada/freeze.adb
......@@ -1776,7 +1776,7 @@ package body Freeze is
Prev := Empty;
while Present (Comp) loop
-- First handle the (real) component case
-- First handle the component case
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant
......@@ -1847,129 +1847,12 @@ package body Freeze is
Component_Name (Component_Clause (Comp)));
end if;
end if;
-- If component clause is present, then deal with the non-
-- default bit order case for Ada 95 mode. The required
-- processing for Ada 2005 mode is handled separately after
-- processing all components.
-- We only do this processing for the base type, and in
-- fact that's important, since otherwise if there are
-- record subtypes, we could reverse the bits once for
-- each subtype, which would be incorrect.
if Present (CC)
and then Reverse_Bit_Order (Rec)
and then Ekind (E) = E_Record_Type
and then Ada_Version <= Ada_95
then
declare
CFB : constant Uint := Component_Bit_Offset (Comp);
CSZ : constant Uint := Esize (Comp);
CLC : constant Node_Id := Component_Clause (Comp);
Pos : constant Node_Id := Position (CLC);
FB : constant Node_Id := First_Bit (CLC);
Storage_Unit_Offset : constant Uint :=
CFB / System_Storage_Unit;
Start_Bit : constant Uint :=
CFB mod System_Storage_Unit;
begin
-- Cases where field goes over storage unit boundary
if Start_Bit + CSZ > System_Storage_Unit then
-- Allow multi-byte field but generate warning
if Start_Bit mod System_Storage_Unit = 0
and then CSZ mod System_Storage_Unit = 0
then
Error_Msg_N
("multi-byte field specified with non-standard"
& " Bit_Order?", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("bytes are not reversed "
& "(component is big-endian)?", CLC);
else
Error_Msg_N
("bytes are not reversed "
& "(component is little-endian)?", CLC);
end if;
-- Do not allow non-contiguous field
else
Error_Msg_N
("attempt to specify non-contiguous field "
& "not permitted", CLC);
Error_Msg_N
("\caused by non-standard Bit_Order "
& "specified", CLC);
Error_Msg_N
("\consider possibility of using "
& "Ada 2005 mode here", CLC);
end if;
-- Case where field fits in one storage unit
else
-- Give warning if suspicious component clause
if Intval (FB) >= System_Storage_Unit
and then Warn_On_Reverse_Bit_Order
then
Error_Msg_N
("?Bit_Order clause does not affect " &
"byte ordering", Pos);
Error_Msg_Uint_1 :=
Intval (Pos) + Intval (FB) /
System_Storage_Unit;
Error_Msg_N
("?position normalized to ^ before bit " &
"order interpreted", Pos);
end if;
-- Here is where we fix up the Component_Bit_Offset
-- value to account for the reverse bit order.
-- Some examples of what needs to be done are:
-- First_Bit .. Last_Bit Component_Bit_Offset
-- old new old new
-- 0 .. 0 7 .. 7 0 7
-- 0 .. 1 6 .. 7 0 6
-- 0 .. 2 5 .. 7 0 5
-- 0 .. 7 0 .. 7 0 4
-- 1 .. 1 6 .. 6 1 6
-- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0
-- The general rule is that the first bit is
-- is obtained by subtracting the old ending bit
-- from storage_unit - 1.
Set_Component_Bit_Offset
(Comp,
(Storage_Unit_Offset * System_Storage_Unit) +
(System_Storage_Unit - 1) -
(Start_Bit + CSZ - 1));
Set_Normalized_First_Bit
(Comp,
Component_Bit_Offset (Comp) mod
System_Storage_Unit);
end if;
end;
end if;
end;
end if;
-- Gather data for possible Implicit_Packing later
-- Gather data for possible Implicit_Packing later. Note that at
-- this stage we might be dealing with a real component, or with
-- an implicit subtype declaration.
if not Is_Scalar_Type (Etype (Comp)) then
All_Scalar_Components := False;
......@@ -2118,7 +2001,7 @@ package body Freeze is
Next_Entity (Comp);
end loop;
-- Deal with pragma Bit_Order
-- Deal with pragma Bit_Order setting non-standard bit order
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
if not Placed_Component then
......@@ -2129,14 +2012,25 @@ package body Freeze is
Error_Msg_N
("\?since no component clauses were specified", ADC);
-- Here is where we do Ada 2005 processing for bit order (the Ada
-- 95 case was already taken care of above).
-- Here is where we do the processing for reversed bit order
elsif Ada_Version >= Ada_05 then
else
Adjust_Record_For_Reverse_Bit_Order (Rec);
end if;
end if;
-- Complete error checking on record representation clause (e.g.
-- overlap of components). This is called after adjusting the
-- record for reverse bit order.
declare
RRC : constant Node_Id := Get_Record_Representation_Clause (Rec);
begin
if Present (RRC) then
Check_Record_Representation_Clause (RRC);
end if;
end;
-- Set OK_To_Reorder_Components depending on debug flags
if Rec = Base_Type (Rec)
......
gcc/ada/sem_ch13.ads
......@@ -38,9 +38,17 @@ package Sem_Ch13 is
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
-- Called from Freeze where R is a record entity for which reverse bit
-- order is specified and there is at least one component clause. Adjusts
-- component positions according to Ada 2005 AI-133. Note that this is only
-- called in Ada 2005 mode. The Ada 95 handling for bit order is entirely
-- contained in Freeze.
-- component positions according to either Ada 95 or Ada 2005 (AI-133).
procedure Check_Record_Representation_Clause (N : Node_Id);
-- This procedure completes the analysis of a record representation clause
-- N. It is called at freeze time after adjustment of component clause bit
-- positions for possible non-standard bit order. In the case of Ada 2005
-- (machine scalar) mode, this adjustment can make substantial changes, so
-- some checks, in particular for component overlaps cannot be done at the
-- time the record representation clause is first seen, but must be delayed
-- till freeze time, and in particular is called after calling the above
-- procedure for adjusting record bit positions for reverse bit order.
procedure Initialize;
-- Initialize internal tables for new compilation
......
gcc/ada/sem_eval.adb
......@@ -2534,9 +2534,9 @@ package body Sem_Eval is
-- Eval_Relational_Op --
------------------------
-- Relational operations are static functions, so the result is static
-- if both operands are static (RM 4.9(7), 4.9(20)), except that for
-- strings, the result is never static, even if the operands are.
-- Relational operations are static functions, so the result is static if
-- both operands are static (RM 4.9(7), 4.9(20)), except that for strings,
-- the result is never static, even if the operands are.
procedure Eval_Relational_Op (N : Node_Id) is
Left : constant Node_Id := Left_Opnd (N);
......@@ -2650,17 +2650,37 @@ package body Sem_Eval is
if Nkind (Expr) = N_Op_Add
and then Compile_Time_Known_Value (Right_Opnd (Expr))
then
Exp := Left_Opnd (Expr);
Exp := Left_Opnd (Expr);
Cons := Expr_Value (Right_Opnd (Expr));
elsif Nkind (Expr) = N_Op_Subtract
and then Compile_Time_Known_Value (Right_Opnd (Expr))
then
Exp := Left_Opnd (Expr);
Exp := Left_Opnd (Expr);
Cons := -Expr_Value (Right_Opnd (Expr));
-- If the bound is a constant created to remove side
-- effects, recover original expression to see if it has
-- one of the recognizable forms.
elsif Nkind (Expr) = N_Identifier
and then not Comes_From_Source (Entity (Expr))
and then Ekind (Entity (Expr)) = E_Constant
and then
Nkind (Parent (Entity (Expr))) = N_Object_Declaration
then
Exp := Expression (Parent (Entity (Expr)));
Decompose_Expr (Exp, Ent, Kind, Cons);
-- If original expression includes an entity, create a
-- reference to it for use below.
if Present (Ent) then
Exp := New_Occurrence_Of (Ent, Sloc (Ent));
end if;
else
Exp := Expr;
Exp := Expr;
Cons := Uint_0;
end if;
......@@ -2669,8 +2689,10 @@ package body Sem_Eval is
if Nkind (Exp) = N_Attribute_Reference then
if Attribute_Name (Exp) = Name_First then
Kind := 'F';
elsif Attribute_Name (Exp) = Name_Last then
Kind := 'L';
else
Ent := Empty;
return;
......
gcc/ada/sem_intr.adb
......@@ -73,9 +73,7 @@ package body Sem_Intr is
procedure Check_Exception_Function (E : Entity_Id; N : Node_Id) is
begin
if Ekind (E) /= E_Function
and then Ekind (E) /= E_Generic_Function
then
if not Ekind_In (E, E_Function, E_Generic_Function) then
Errint
("intrinsic exception subprogram must be a function", E, N);
......@@ -374,9 +372,7 @@ package body Sem_Intr is
Ptyp2 : Node_Id;
begin
if Ekind (E) /= E_Function
and then Ekind (E) /= E_Generic_Function
then
if not Ekind_In (E, E_Function, E_Generic_Function) then
Errint ("intrinsic shift subprogram must be a function", E, N);
return;
end if;
......
gcc/ada/sem_prag.adb
......@@ -1846,7 +1846,8 @@ package body Sem_Prag is
Proc := Entity (Name);
if Ekind (Proc) /= E_Procedure
or else Present (First_Formal (Proc)) then
or else Present (First_Formal (Proc))
then
Error_Pragma_Arg
("argument of pragma% must be parameterless procedure", Arg);
end if;
......@@ -2516,10 +2517,7 @@ package body Sem_Prag is
-- Check that we are not applying this to a named constant
if Ekind (E) = E_Named_Integer
or else
Ekind (E) = E_Named_Real
then
if Ekind_In (E, E_Named_Integer, E_Named_Real) then
Error_Msg_Name_1 := Pname;
Error_Msg_N
("cannot apply pragma% to named constant!",
......@@ -2756,9 +2754,7 @@ package body Sem_Prag is
Process_Extended_Import_Export_Internal_Arg (Arg_Internal);
Def_Id := Entity (Arg_Internal);
if Ekind (Def_Id) /= E_Constant
and then Ekind (Def_Id) /= E_Variable
then
if not Ekind_In (Def_Id, E_Constant, E_Variable) then
Error_Pragma_Arg
("pragma% must designate an object", Arg_Internal);
end if;
......@@ -3368,10 +3364,8 @@ package body Sem_Prag is
Kill_Size_Check_Code (Def_Id);
Note_Possible_Modification (Expression (Arg2), Sure => False);
if Ekind (Def_Id) = E_Variable
or else
Ekind (Def_Id) = E_Constant
then
if Ekind_In (Def_Id, E_Variable, E_Constant) then
-- We do not permit Import to apply to a renaming declaration
if Present (Renamed_Object (Def_Id)) then
......@@ -9131,9 +9125,7 @@ package body Sem_Prag is
while Present (E)
and then Scope (E) = Current_Scope
loop
if Ekind (E) = E_Procedure
or else Ekind (E) = E_Generic_Procedure
then
if Ekind_In (E, E_Procedure, E_Generic_Procedure) then
Set_No_Return (E);
-- Set flag on any alias as well
......@@ -10291,9 +10283,7 @@ package body Sem_Prag is
Def_Id := Entity (Internal);
if Ekind (Def_Id) /= E_Constant
and then Ekind (Def_Id) /= E_Variable
then
if not Ekind_In (Def_Id, E_Constant, E_Variable) then
Error_Pragma_Arg
("pragma% must designate an object", Internal);
end if;
......@@ -10459,9 +10449,9 @@ package body Sem_Prag is
loop
Def_Id := Get_Base_Subprogram (E);
if Ekind (Def_Id) /= E_Function
and then Ekind (Def_Id) /= E_Generic_Function
and then Ekind (Def_Id) /= E_Operator
if not Ekind_In (Def_Id, E_Function,
E_Generic_Function,
E_Operator)
then
Error_Pragma_Arg
("pragma% requires a function name", Arg1);
......
gcc/ada/sem_res.adb
......@@ -3534,9 +3534,7 @@ package body Sem_Res is
-- might not be done in the In Out case since Gigi does not do
-- any analysis. More thought required about this ???
if Ekind (F) = E_In_Parameter
or else Ekind (F) = E_In_Out_Parameter
then
if Ekind_In (F, E_In_Parameter, E_In_Out_Parameter) then
if Is_Scalar_Type (Etype (A)) then
Apply_Scalar_Range_Check (A, F_Typ);
......@@ -3582,9 +3580,7 @@ package body Sem_Res is
end if;
end if;
if Ekind (F) = E_Out_Parameter
or else Ekind (F) = E_In_Out_Parameter
then
if Ekind_In (F, E_Out_Parameter, E_In_Out_Parameter) then
if Nkind (A) = N_Type_Conversion then
if Is_Scalar_Type (A_Typ) then
Apply_Scalar_Range_Check
......@@ -6163,9 +6159,7 @@ package body Sem_Res is
Resolve_Actuals (N, Nam);
Generate_Reference (Nam, Entry_Name);
if Ekind (Nam) = E_Entry
or else Ekind (Nam) = E_Entry_Family
then
if Ekind_In (Nam, E_Entry, E_Entry_Family) then
Check_Potentially_Blocking_Operation (N);
end if;
......@@ -8559,9 +8553,7 @@ package body Sem_Res is
-- Handle subtypes
if Ekind (Opnd) = E_Protected_Subtype
or else Ekind (Opnd) = E_Task_Subtype
then
if Ekind_In (Opnd, E_Protected_Subtype, E_Task_Subtype) then
Opnd := Etype (Opnd);
end if;
......@@ -8954,19 +8946,20 @@ package body Sem_Res is
Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
Set_Scalar_Range (Index_Subtype, Drange);
-- Take a new copy of Drange (where bounds have been rewritten to
-- reference side-effect-vree names). Using a separate tree ensures
-- that further expansion (e.g while rewriting a slice assignment
-- into a FOR loop) does not attempt to remove side effects on the
-- bounds again (which would cause the bounds in the index subtype
-- definition to refer to temporaries before they are defined) (the
-- reason is that some names are considered side effect free here
-- for the subtype, but not in the context of a loop iteration
-- scheme).
Set_Scalar_Range (Index_Subtype, New_Copy_Tree (Drange));
Set_Etype (Index_Subtype, Index_Type);
Set_Size_Info (Index_Subtype, Index_Type);
Set_RM_Size (Index_Subtype, RM_Size (Index_Type));
-- Now replace the discrete range in the slice with a reference to
-- its index subtype. This ensures that further expansion (e.g
-- while rewriting a slice assignment into a FOR loop) does not
-- attempt to remove side effects on the bounds again (which would
-- cause the bounds in the index subtype definition to refer to
-- temporaries before they are defined).
Set_Discrete_Range (N, New_Copy_Tree (Drange));
end if;
Slice_Subtype := Create_Itype (E_Array_Subtype, N);
......@@ -8979,15 +8972,26 @@ package body Sem_Res is
Set_Etype (Slice_Subtype, Base_Type (Etype (N)));
Set_Is_Constrained (Slice_Subtype, True);
Check_Compile_Time_Size (Slice_Subtype);
-- The Etype of the existing Slice node is reset to this slice subtype.
-- Its bounds are obtained from its first index.
Set_Etype (N, Slice_Subtype);
-- Always freeze subtype. This ensures that the slice subtype is
-- elaborated in the scope of the expression.
-- For packed slice subtypes, freeze immediately. Otherwise insert an
-- itype reference in the slice's actions so that the itype is frozen
-- at the proper place in the tree (i.e. at the point where actions
-- for the slice are analyzed). Note that this is different from
-- freezing the itype immediately, which might be premature (e.g. if
-- the slice is within a transient scope).
if Is_Packed (Slice_Subtype) and not In_Spec_Expression then
Freeze_Itype (Slice_Subtype, N);
Freeze_Itype (Slice_Subtype, N);
else
Ensure_Defined (Typ => Slice_Subtype, N => N);
end if;
end Set_Slice_Subtype;
--------------------------------
......@@ -9732,7 +9736,6 @@ package body Sem_Res is
elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type
and then not Is_Local_Anonymous_Access (Opnd_Type)
then
-- When the operand is a selected access discriminant the check
-- needs to be made against the level of the object denoted by
-- the prefix of the selected name (Object_Access_Level handles
......
gcc/ada/sem_type.adb
......@@ -362,7 +362,6 @@ package body Sem_Type is
-- performed, given that the operator was visible in the generic.
if Ekind (E) = E_Operator then
if Present (Opnd_Type) then
Vis_Type := Opnd_Type;
else
......@@ -803,8 +802,8 @@ package body Sem_Type is
then
return True;
-- The context may be class wide, and a class-wide type is
-- compatible with any member of the class.
-- The context may be class wide, and a class-wide type is compatible
-- with any member of the class.
elsif Is_Class_Wide_Type (T1)
and then Is_Ancestor (Root_Type (T1), T2)
......@@ -997,9 +996,7 @@ package body Sem_Type is
-- imposed by context.
elsif Ekind (T2) = E_Access_Attribute_Type
and then (Ekind (BT1) = E_General_Access_Type
or else
Ekind (BT1) = E_Access_Type)
and then Ekind_In (BT1, E_General_Access_Type, E_Access_Type)
and then Covers (Designated_Type (T1), Designated_Type (T2))
then
-- If the target type is a RACW type while the source is an access
......@@ -1677,9 +1674,8 @@ package body Sem_Type is
elsif Nkind (Parent (N)) = N_Object_Renaming_Declaration
and then Present (Access_Definition (Parent (N)))
then
if Ekind (It1.Typ) = E_Anonymous_Access_Type
or else
Ekind (It1.Typ) = E_Anonymous_Access_Subprogram_Type
if Ekind_In (It1.Typ, E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
then
if Ekind (It2.Typ) = Ekind (It1.Typ) then
......@@ -1691,9 +1687,8 @@ package body Sem_Type is
return It1;
end if;
elsif Ekind (It2.Typ) = E_Anonymous_Access_Type
or else
Ekind (It2.Typ) = E_Anonymous_Access_Subprogram_Type
elsif Ekind_In (It2.Typ, E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
then
return It2;
......@@ -1880,8 +1875,8 @@ package body Sem_Type is
if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type
and then
List_Containing (Parent (Designated_Type (Etype (Opnd))))
= List_Containing (Unit_Declaration_Node (User_Subp))
List_Containing (Parent (Designated_Type (Etype (Opnd))))
= List_Containing (Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;
......
gcc/ada/sem_util.adb
......@@ -2817,9 +2817,7 @@ package body Sem_Util is
-- Avoid cascaded messages with duplicate components in
-- derived types.
if Ekind (E) = E_Component
or else Ekind (E) = E_Discriminant
then
if Ekind_In (E, E_Component, E_Discriminant) then
return;
end if;
end if;
......@@ -2854,9 +2852,7 @@ package body Sem_Util is
-- midst of inheriting components in a derived record definition.
-- Preserve their Ekind and Etype.
if Ekind (Def_Id) = E_Discriminant
or else Ekind (Def_Id) = E_Component
then
if Ekind_In (Def_Id, E_Discriminant, E_Component) then
null;
-- If a type is already set, leave it alone (happens whey a type
......@@ -2876,8 +2872,7 @@ package body Sem_Util is
-- Inherited discriminants and components in derived record types are
-- immediately visible. Itypes are not.
if Ekind (Def_Id) = E_Discriminant
or else Ekind (Def_Id) = E_Component
if Ekind_In (Def_Id, E_Discriminant, E_Component)
or else (No (Corresponding_Remote_Type (Def_Id))
and then not Is_Itype (Def_Id))
then
......@@ -4848,10 +4843,8 @@ package body Sem_Util is
-- We are interested only in components and discriminants
if Ekind (Ent) = E_Component
or else
Ekind (Ent) = E_Discriminant
then
if Ekind_In (Ent, E_Component, E_Discriminant) then
-- Get default expression if any. If there is no declaration
-- node, it means we have an internal entity. The parent and
-- tag fields are examples of such entities. For these cases,
......@@ -6376,10 +6369,7 @@ package body Sem_Util is
Ent : constant Entity_Id := Entity (Expr);
Sub : constant Entity_Id := Enclosing_Subprogram (Ent);
begin
if Ekind (Ent) /= E_Variable
and then
Ekind (Ent) /= E_In_Out_Parameter
then
if not Ekind_In (Ent, E_Variable, E_In_Out_Parameter) then
return False;
else
return Present (Sub) and then Sub = Current_Subprogram;
......@@ -8658,9 +8648,7 @@ package body Sem_Util is
-- If a record subtype is simply copied, the entity list will be
-- shared. Thus cloned_Subtype must be set to indicate the sharing.
if Ekind (Old_Itype) = E_Record_Subtype
or else Ekind (Old_Itype) = E_Class_Wide_Subtype
then
if Ekind_In (Old_Itype, E_Record_Subtype, E_Class_Wide_Subtype) then
Set_Cloned_Subtype (New_Itype, Old_Itype);
end if;
......@@ -10151,12 +10139,7 @@ package body Sem_Util is
while R_Scope /= Standard_Standard loop
exit when R_Scope = E_Scope;
if Ekind (R_Scope) /= E_Package
and then
Ekind (R_Scope) /= E_Block
and then
Ekind (R_Scope) /= E_Loop
then
if not Ekind_In (R_Scope, E_Package, E_Block, E_Loop) then
return False;
else
R_Scope := Scope (R_Scope);
......
gcc/ada/sem_warn.adb
......@@ -1027,9 +1027,8 @@ package body Sem_Warn is
-- we exclude protected types, too complicated to worry about.
if Ekind (E1) = E_Variable
or else
((Ekind (E1) = E_Out_Parameter
or else Ekind (E1) = E_In_Out_Parameter)
or else
(Ekind_In (E1, E_Out_Parameter, E_In_Out_Parameter)
and then not Is_Protected_Type (Current_Scope))
then
-- Case of an unassigned variable
......@@ -1345,7 +1344,7 @@ package body Sem_Warn is
while Present (Comp) loop
if Ekind (Comp) = E_Component
and then Nkind (Parent (Comp)) =
N_Component_Declaration
N_Component_Declaration
and then No (Expression (Parent (Comp)))
then
Error_Msg_Node_2 := Comp;
......@@ -2883,9 +2882,7 @@ package body Sem_Warn is
-- Reference to obsolescent component
elsif Ekind (E) = E_Component
or else Ekind (E) = E_Discriminant
then
elsif Ekind_In (E, E_Component, E_Discriminant) then
Error_Msg_NE
("?reference to obsolescent component& declared#", N, E);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment