2010-06-17 Robert Dewar <dewar@adacore.com>
+ * einfo.adb: Minor code fix, allow E_Class_Wide_Type for
+ Equivalent_Type to match documentation.
+
+2010-06-17 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch6.adb, sem_ch7.adb: Minor reformatting.
+ * sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_ch10.adb, sem_ch12.adb,
+ sem_ch4.adb, sem_ch8.adb, sem_ch13.adb: Make use of Ekind_In.
+
+2010-06-17 Thomas Quinot <quinot@adacore.com>
+
+ * sem_res.adb (Set_Slice_Subtype): Always freeze the slice's itype.
+
+2010-06-17 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb (Freeze_Expression): Short circuit operators are valid
+ freeze node insertion points.
+
+2010-06-17 Robert Dewar <dewar@adacore.com>
+
* switch-c.ads, switch-c.adb, sem_ch13.adb: Minor reformatting.
* sem_ch12.adb: Add pragmas Assert and Check to previous change.
function Equivalent_Type (Id : E) return E is
begin
pragma Assert
- (Ekind_In (Id, E_Class_Wide_Subtype,
+ (Ekind_In (Id, E_Class_Wide_Type,
+ E_Class_Wide_Subtype,
E_Access_Protected_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type,
E_Access_Subprogram_Type,
Write_Str ("Spec_PPC_List");
when E_Record_Type =>
- Write_Str ("Underlying record view");
+ Write_Str ("Underlying_Record_View");
when E_Variable | E_Constant =>
- Write_Str ("Related expression");
+ Write_Str ("Related_Expression");
when others =>
Write_Str ("???");
-- exiting from the loop when it is appropriate to insert the freeze
-- node before the current node P.
- -- Also checks som special exceptions to the freezing rules. These cases
- -- result in a direct return, bypassing the freeze action.
+ -- Also checks some special exceptions to the freezing rules. These
+ -- cases result in a direct return, bypassing the freeze action.
P := N;
loop
N_Entry_Call_Alternative |
N_Triggering_Alternative |
N_Abortable_Part |
+ N_And_Then |
+ N_Or_Else |
N_Freeze_Entity =>
exit when Is_List_Member (P);
then
return True;
- elsif Ekind (E) = E_Generic_Function
- or else Ekind (E) = E_Generic_Procedure
- then
+ elsif Ekind_In (E, E_Generic_Function, E_Generic_Procedure) then
return True;
elsif Ekind (E) = E_Generic_Package
then
Set_Body_Needed_For_SAL (Unit_Name);
- elsif Ekind (Unit_Name) = E_Generic_Procedure
- or else
- Ekind (Unit_Name) = E_Generic_Function
- then
+ elsif Ekind_In (Unit_Name, E_Generic_Procedure, E_Generic_Function) then
Set_Body_Needed_For_SAL (Unit_Name);
elsif Is_Subprogram (Unit_Name)
end if;
elsif Nkind (Prefix (Def)) = N_Selected_Component then
- if Ekind (Entity (Selector_Name (Prefix (Def))))
- /= E_Entry_Family
+ if Ekind (Entity (Selector_Name (Prefix (Def)))) /=
+ E_Entry_Family
then
Error_Msg_N ("expect valid subprogram name as default", Def);
end if;
-- Verify that it is a generic subprogram of the right kind, and that
-- it does not lead to a circular instantiation.
- if Ekind (Gen_Unit) /= E_Generic_Procedure
- and then Ekind (Gen_Unit) /= E_Generic_Function
- then
+ if not Ekind_In (Gen_Unit, E_Generic_Procedure, E_Generic_Function) then
Error_Msg_N ("expect generic subprogram in instantiation", Gen_Id);
elsif In_Open_Scopes (Gen_Unit) then
-- then so far the subprograms correspond, so
-- now check that any result types correspond.
- if No (Anc_Formal)
- and then No (Act_Formal)
- then
+ if No (Anc_Formal) and then No (Act_Formal) then
Subprograms_Correspond := True;
if Ekind (Act_Subp) = E_Function then
-- exchanged explicitly now, in order to remain consistent with the
-- view of the parent type.
- if Ekind (Typ) = E_Private_Type
- or else Ekind (Typ) = E_Limited_Private_Type
- or else Ekind (Typ) = E_Record_Type_With_Private
+ if Ekind_In (Typ, E_Private_Type,
+ E_Limited_Private_Type,
+ E_Record_Type_With_Private)
then
Dep_Elmt := First_Elmt (Private_Dependents (Typ));
while Present (Dep_Elmt) loop
-- it imported.
if Ignore_Rep_Clauses then
- if Ekind (U_Ent) = E_Variable
- or else Ekind (U_Ent) = E_Constant
- then
+ if Ekind_In (U_Ent, E_Variable, E_Constant) then
Record_Rep_Item (U_Ent, N);
end if;
Nam);
return;
- elsif Ekind (U_Ent) /= E_Access_Type
- and then Ekind (U_Ent) /= E_General_Access_Type
+ elsif not
+ Ekind_In (U_Ent, E_Access_Type, E_General_Access_Type)
then
Error_Msg_N
("storage pool can only be given for access types", Nam);
Parent_Last_Bit := UI_From_Int (System_Address_Size - 1);
Pcomp := First_Entity (Tagged_Parent);
while Present (Pcomp) loop
- if Ekind (Pcomp) = E_Discriminant
- or else
- Ekind (Pcomp) = E_Component
- then
+ if Ekind_In (Pcomp, E_Discriminant, E_Component) then
if Component_Bit_Offset (Pcomp) /= No_Uint
and then Known_Static_Esize (Pcomp)
then
-- This latter test is repeated recursively up the variant tree.
Main_Component_Loop : while Present (C1_Ent) loop
- if Ekind (C1_Ent) /= E_Component
- and then Ekind (C1_Ent) /= E_Discriminant
- then
+ if not Ekind_In (C1_Ent, E_Component, E_Discriminant) then
goto Continue_Main_Component_Loop;
end if;
-- Otherwise look at the identifier and see if it is OK
- if Ekind (Ent) = E_Named_Integer
- or else
- Ekind (Ent) = E_Named_Real
- or else
- Is_Type (Ent)
+ if Ekind_In (Ent, E_Named_Integer, E_Named_Real)
+ or else Is_Type (Ent)
then
return;
Out_Present => Out_P,
Parameter_Type => T_Ref));
- Spec := Make_Procedure_Specification (Loc,
- Defining_Unit_Name => Subp_Id,
- Parameter_Specifications => Formals);
+ Spec :=
+ Make_Procedure_Specification (Loc,
+ Defining_Unit_Name => Subp_Id,
+ Parameter_Specifications => Formals);
end if;
return Spec;
("parent of type extension must be a tagged type ", Indic);
return;
- elsif Ekind (Parent_Type) = E_Void
- or else Ekind (Parent_Type) = E_Incomplete_Type
- then
+ elsif Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then
Error_Msg_N ("premature derivation of incomplete type", Indic);
return;
begin
D := First_Entity (Derived_Type);
while Present (D) loop
- if Ekind (D) = E_Discriminant
- or else Ekind (D) = E_Component
- then
+ if Ekind_In (D, E_Discriminant, E_Component) then
if Is_Itype (Etype (D))
and then Ekind (Etype (D)) = E_Anonymous_Access_Type
then
begin
if not Comes_From_Source (E) then
- if Ekind (E) = E_Task_Type
- or else Ekind (E) = E_Protected_Type
- then
+ if Ekind_In (E, E_Task_Type, E_Protected_Type) then
-- It may be an anonymous protected type created for a
-- single variable. Post error on variable, if present.
& " must be in private part", N);
elsif Ekind (Current_Scope) = E_Package
- and then List_Containing (Parent (Prev))
- /= Visible_Declarations
- (Specification (Unit_Declaration_Node (Current_Scope)))
+ and then
+ List_Containing (Parent (Prev)) /=
+ Visible_Declarations
+ (Specification (Unit_Declaration_Node (Current_Scope)))
then
Error_Msg_N
("deferred constant must be declared in visible part",
-- Check for early use of incomplete or private type
- if Ekind (Parent_Type) = E_Void
- or else Ekind (Parent_Type) = E_Incomplete_Type
- then
+ if Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then
Error_Msg_N ("premature derivation of incomplete type", Indic);
return;
then
null;
- elsif Ekind (Derived_Base) = E_Private_Type
- or else Ekind (Derived_Base) = E_Limited_Private_Type
+ elsif Ekind_In (Derived_Base, E_Private_Type,
+ E_Limited_Private_Type)
then
null;
-- Start of processing for Is_Visible_Component
begin
- if Ekind (C) = E_Component
- or else Ekind (C) = E_Discriminant
- then
+ if Ekind_In (C, E_Component, E_Discriminant) then
Original_Comp := Original_Record_Component (C);
end if;
while Present (Priv_Elmt) loop
Priv := Node (Priv_Elmt);
- if Ekind (Priv) = E_Private_Subtype
- or else Ekind (Priv) = E_Limited_Private_Subtype
- or else Ekind (Priv) = E_Record_Subtype_With_Private
+ if Ekind_In (Priv, E_Private_Subtype,
+ E_Limited_Private_Subtype,
+ E_Record_Subtype_With_Private)
then
Full := Make_Defining_Identifier (Sloc (Priv), Chars (Priv));
Set_Is_Itype (Full);
Prim := Next_Entity (Full_T);
while Present (Prim) and then Prim /= Priv_T loop
- if Ekind (Prim) = E_Procedure
- or else
- Ekind (Prim) = E_Function
- then
+ if Ekind_In (Prim, E_Procedure, E_Function) then
Disp_Typ := Find_Dispatching_Type (Prim);
if Disp_Typ = Full_T
elsif Nkind (Nam) = N_Selected_Component then
Nam_Ent := Entity (Selector_Name (Nam));
- if Ekind (Nam_Ent) /= E_Entry
- and then Ekind (Nam_Ent) /= E_Entry_Family
- and then Ekind (Nam_Ent) /= E_Function
- and then Ekind (Nam_Ent) /= E_Procedure
+ if not Ekind_In (Nam_Ent, E_Entry,
+ E_Entry_Family,
+ E_Function,
+ E_Procedure)
then
Error_Msg_N ("name in call is not a callable entity", Nam);
Set_Etype (N, Any_Type);
if Present (Op_Id) then
if Ekind (Op_Id) = E_Operator then
-
LT := Base_Type (Etype (L));
RT := Base_Type (Etype (R));
elsif Ekind (Etype (P)) = E_Subprogram_Type
or else (Is_Access_Type (Etype (P))
and then
- Ekind (Designated_Type (Etype (P))) = E_Subprogram_Type)
+ Ekind (Designated_Type (Etype (P))) =
+ E_Subprogram_Type)
then
-- Call to access_to-subprogram with possible implicit dereference
if Ekind (P_T) = E_Subprogram_Type
or else (Is_Access_Type (P_T)
and then
- Ekind (Designated_Type (P_T)) = E_Subprogram_Type)
+ Ekind (Designated_Type (P_T)) = E_Subprogram_Type)
then
Process_Function_Call;
Has_Candidate := True;
end if;
- elsif Ekind (Comp) = E_Discriminant
- or else Ekind (Comp) = E_Entry_Family
- or else (In_Scope
- and then Is_Entity_Name (Name))
+ elsif Ekind_In (Comp, E_Discriminant, E_Entry_Family)
+ or else (In_Scope and then Is_Entity_Name (Name))
then
Set_Entity_With_Style_Check (Sel, Comp);
Generate_Reference (Comp, Sel);
if Nkind (N) = N_Function_Call then
Get_First_Interp (Nam, X, It);
while Present (It.Nam) loop
- if Ekind (It.Nam) = E_Function
- or else Ekind (It.Nam) = E_Operator
- then
+ if Ekind_In (It.Nam, E_Function, E_Operator) then
return;
else
Get_Next_Interp (X, It);
if Is_Derived_Type (T) then
return Primitive_Operations (T);
- elsif Ekind (Scope (T)) = E_Procedure
- or else Ekind (Scope (T)) = E_Function
- then
+ elsif Ekind_In (Scope (T), E_Procedure, E_Function) then
+
-- Scan the list of generic formals to find subprograms
-- that may have a first controlling formal of the type.
if Is_Entity_Name (Exp) then
Ent := Entity (Exp);
- if Ekind (Ent) = E_Variable
- or else
- Ekind (Ent) = E_In_Out_Parameter
- or else
- Ekind (Ent) = E_Out_Parameter
+ if Ekind_In (Ent, E_Variable,
+ E_In_Out_Parameter,
+ E_Out_Parameter)
then
if List_Length (Choices) = 1
and then Nkind (First (Choices)) in N_Subexpr
or else Is_Child_Unit (S)
then
return False;
+
elsif Ekind (S) = E_Package
and then Has_Forward_Instantiation (S)
then
-- instance of) a generic type.
Formal := First_Formal (Prev_E);
-
while Present (Formal) loop
F_Typ := Base_Type (Etype (Formal));
-- but the formals are private and remain so.
if Ekind (Id) = E_Function
- and then Is_Operator_Symbol_Name (Chars (Id))
+ and then Is_Operator_Symbol_Name (Chars (Id))
and then not Is_Hidden (Id)
and then not Error_Posted (Id)
then
begin
if not Is_Overloaded (P) then
if Ekind (Etype (Nam)) /= E_Subprogram_Type
- or else not Type_Conformant (Etype (Nam), New_S) then
+ or else not Type_Conformant (Etype (Nam), New_S)
+ then
Error_Msg_N ("designated type does not match specification", P);
else
Resolve (P);
while Present (It.Nam) loop
if Ekind (It.Nam) = E_Subprogram_Type
- and then Type_Conformant (It.Nam, New_S) then
-
+ and then Type_Conformant (It.Nam, New_S)
+ then
if Typ /= Any_Id then
Error_Msg_N ("ambiguous renaming", P);
return;
-- Guard against previous errors, and omit renamings of predefined
-- operators.
- elsif Ekind (Old_S) /= E_Function
- and then Ekind (Old_S) /= E_Procedure
- then
+ elsif not Ekind_In (Old_S, E_Function, E_Procedure) then
null;
elsif Requires_Overriding (Old_S)
exit when S = Standard_Standard;
- if Ekind (S) = E_Function
- or else Ekind (S) = E_Package
- or else Ekind (S) = E_Procedure
+ if Ekind_In (S, E_Function,
+ E_Package,
+ E_Procedure)
then
P := Generic_Parent (Specification
(Unit_Declaration_Node (S)));
Next_Formal (Old_F);
end loop;
- if Ekind (Old_S) = E_Function
- or else Ekind (Old_S) = E_Enumeration_Literal
- then
+ if Ekind_In (Old_S, E_Function, E_Enumeration_Literal) then
Set_Etype (New_S, Etype (Old_S));
end if;
end if;
E := First_Entity (Current_Scope);
while Present (E) loop
- if Ekind (E) = E_Function
- or else Ekind (E) = E_Procedure
- then
+ if Ekind_In (E, E_Function, E_Procedure) then
Set_Convention (E, Convention_Protected);
elsif Is_Task_Type (Etype (E))
Enclosing := Scope_Stack.Table (J).Entity;
exit when Is_Entry (Enclosing);
- if Ekind (Enclosing) /= E_Block
- and then Ekind (Enclosing) /= E_Loop
- then
+ if not Ekind_In (Enclosing, E_Block, E_Loop) then
Error_Msg_N ("requeue must appear within accept or entry body", N);
return;
end if;
-- perform an unconditional goto so that any further
-- references will not occur anyway.
- if Ekind (Ent) = E_Out_Parameter
- or else
- Ekind (Ent) = E_In_Out_Parameter
- then
+ if Ekind_In (Ent, E_Out_Parameter, E_In_Out_Parameter) then
Set_Never_Set_In_Source (Ent, False);
Set_Is_True_Constant (Ent, False);
end if;
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);
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.
-- In the packed case, this must be immediately frozen
- -- Couldn't we always freeze here??? and if we did, then the above
- -- call to Check_Compile_Time_Size could be eliminated, which would
- -- be nice, because then that routine could be made private to Freeze.
+ -- Always freeze subtype. This ensures that the slice subtype is
+ -- elaborated in the scope of the expression.
- -- Why the test for In_Spec_Expression here ???
-
- if Is_Packed (Slice_Subtype) and not In_Spec_Expression then
- Freeze_Itype (Slice_Subtype, N);
- end if;
+ Freeze_Itype (Slice_Subtype, N);
end Set_Slice_Subtype;
OSDN Git Service
