+2011-08-02 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch5.adb, sem_ch7.adb, einfo.ads, sem_util.adb, sem_util.ads,
+ sem_res.adb, sem_ch6.adb: Minor reformatting.
+
+2011-08-02 Jerome Guitton <guitton@adacore.com>
+
+ * a-except-2005.adb (Raise_Current_Excep): Remove obsolete dead code.
+
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (New_Overloaded_Entity, Check_Overriding_Indicator): Do
-------------------------
procedure Raise_Current_Excep (E : Exception_Id) is
-
- pragma Inspection_Point (E);
- -- This is so the debugger can reliably inspect the parameter when
- -- inserting a breakpoint at the start of this procedure.
-
- -- To provide support for breakpoints on unhandled exceptions, the
- -- debugger will also need to be able to inspect the value of E from
- -- inner frames so we need to make sure that its value is also spilled
- -- on stack. We take the address and dereference using volatile local
- -- objects for this purpose.
-
- -- The pragma Warnings (Off) are needed because the compiler knows that
- -- these locals are not referenced and that this use of pragma Volatile
- -- is peculiar!
-
- type EID_Access is access Exception_Id;
-
- Access_To_E : EID_Access := E'Unrestricted_Access;
- pragma Volatile (Access_To_E);
- pragma Warnings (Off, Access_To_E);
-
- Id : Exception_Id := Access_To_E.all;
- pragma Volatile (Id);
- pragma Warnings (Off, Id);
-
begin
Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
Exception_Propagation.Propagate_Exception
-- Overridden_Operation (Node26)
-- Present in subprograms. For overriding operations, points to the
--- user-defined parent subprogram that is being overridden.
+-- user-defined parent subprogram that is being overridden. Note: this
+-- attribute uses the same field as Static_Initialization. The latter
+-- is only defined for internal initialization procedures, for which
+-- Overridden_Operation is irrelevant. Thus this attribute must not be
+-- set for init_procs.
-- Package_Instantiation (Node26)
-- Present in packages and generic packages. When present, this field
-- initialized statically. The value of this attribute is a positional
-- aggregate whose components are compile-time static values. Used
-- when available in object declarations to eliminate the call to the
--- initialization procedure, and to minimize elaboration code.
+-- initialization procedure, and to minimize elaboration code. Note:
+-- This attribute uses the same field as Overridden_Operation, which is
+-- irrelevant in init_procs.
-- Stored_Constraint (Elist23)
-- Present in entities that can have discriminants (concurrent types
HSS : constant Node_Id := Handled_Statement_Sequence (N);
begin
- -- Only reject block statements that originate from a source block
- -- statement, in formal mode.
+ -- In formal mode, we reject block statements. Note that the case of
+ -- block statements generated by the expander is fine.
if Nkind (Original_Node (N)) = N_Block_Statement then
Check_Formal_Restriction ("block statement is not allowed", N);
then
Set_Overridden_Operation (S, Alias (E));
+ -- Normal case of setting entity as overridden
+
+ -- Note: Static_Initialization and Overridden_Operation
+ -- attributes use the same field in subprogram entities.
+ -- Static_Initialization is only defined for internal
+ -- initialization procedures, where Overridden_Operation
+ -- is irrelevant. Therefore the setting of this attribute
+ -- must check whether the target is an init_proc.
+
elsif not Is_Init_Proc (S) then
Set_Overridden_Operation (S, E);
end if;
procedure Check_Decls (Decls : List_Id) is
Decl : Node_Id;
+
begin
Decl := First (Decls);
while Present (Decl) loop
then
if No (Previous) then
Previous := Decl;
+
else
Error_Msg_Sloc := Sloc (Previous);
Check_Formal_Restriction
F_Typ := Etype (F);
if Comes_From_Source (Original_Node (N))
- and then Nkind_In (Original_Node (N),
- N_Function_Call,
- N_Procedure_Call_Statement)
+ and then Nkind_In (Original_Node (N), N_Function_Call,
+ N_Procedure_Call_Statement)
then
-- In formal mode, check that actual parameters matching
-- formals of tagged types are objects (or ancestor type
return Present (Entity (N))
and then
(Ekind_In (Entity (N), E_Constant, E_Variable)
- or else Ekind (Entity (N)) in Formal_Kind);
+ or else Ekind (Entity (N)) in Formal_Kind);
else
- case Nkind (N) is
- when N_Selected_Component =>
- return Is_SPARK_Object_Reference (Prefix (N));
-
- when others =>
- return False;
- end case;
+ if Nkind (N) = N_Selected_Component then
+ return Is_SPARK_Object_Reference (Prefix (N));
+ else
+ return False;
+ end if;
end if;
end Is_SPARK_Object_Reference;
Call : out Node_Id);
-- Determines if the node N is an actual parameter of a function of a
-- procedure call. If so, then Formal points to the entity for the formal
- -- (whose Ekind is one of E_In_Parameter, E_Out_Parameter,
- -- E_In_Out_Parameter) and Call is set to the node for the corresponding
- -- call. If the node N is not an actual parameter then Formal and Call are
- -- set to Empty.
+ -- (Ekind is E_In_Parameter, E_Out_Parameter, or E_In_Out_Parameter) and
+ -- Call is set to the node for the corresponding call. If the node N is not
+ -- an actual parameter then Formal and Call are set to Empty.
function Find_Corresponding_Discriminant
(Id : Node_Id;
-- variable and constant objects return True (compare Is_Variable).
function Is_SPARK_Object_Reference (N : Node_Id) return Boolean;
- -- Determines if the tree referenced by N represents an object in SPARK.
+ -- Determines if the tree referenced by N represents an object in SPARK
function Is_OK_Variable_For_Out_Formal (AV : Node_Id) return Boolean;
-- Used to test if AV is an acceptable formal for an OUT or IN OUT formal.