+2011-08-30 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_res.adb (Valid_Conversion): Revise test for implicit anonymous
+ access conversions to check that the conversion is a rewritten node,
+ rather than just having Comes_From_Source set to False, which wasn't
+ sufficient.
+
+2011-08-30 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb, sem_ch9.adb, sem_ch6.adb, exp_disp.adb,
+ g-socket.ads: Minor reformatting.
+
+2011-08-30 Thomas Quinot <quinot@adacore.com>
+
+ * sem_util.adb: Minor reformatting.
+
+2011-08-30 Tristan Gingold <gingold@adacore.com>
+
+ * raise-gcc.c: Never catch exception if _UA_FORCE_UNWIND flag is set,
+ to be compliant with the ABI.
+
2011-08-30 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch12.adb (Check_Private_View): Exchange the private and full view
then
First_Param :=
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc,
- Chars => Name_uO),
- In_Present => True,
- Out_Present => False,
- Parameter_Type => New_Reference_To (Obj_Typ, Loc));
+ Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
+ In_Present => True,
+ Out_Present => False,
+ Parameter_Type => New_Reference_To (Obj_Typ, Loc));
-- For entries and procedures of protected types the mode of
-- the controlling argument must be in-out.
if Expander_Active
and then not ALFA_Mode
then
-
-- If we have no handled statement sequence, we may need to build
-- a dummy sequence consisting of a null statement. This can be
-- skipped if the trivial accept optimization is permitted.
then
Set_Handled_Statement_Sequence (N,
Make_Handled_Sequence_Of_Statements (Loc,
- New_List (Make_Null_Statement (Loc))));
+ Statements => New_List (Make_Null_Statement (Loc))));
end if;
-- Create and declare two labels to be placed at the end of the
elsif Expander_Active
and then not ALFA_Mode
then
-
-- Associate discriminals with the first subprogram or entry body to
-- be expanded.
end if;
-- Expand_Dispatching_Call is called directly from the semantics,
- -- so we need a check to see whether expansion is active before
- -- proceeding. In addition, there is no need to expand the call
- -- if we are compiling under restriction No_Dispatching_Calls;
- -- the semantic analyzer has previously notified the violation
- -- of this restriction.
+ -- so we only proceed if the expander is active.
if not Expander_Active
+
+ -- And this expansion is not required in special ALFA mode expansion
+
or else ALFA_Mode
+
+ -- And there is no need to expand the call if we are compiling under
+ -- restriction No_Dispatching_Calls; the semantic analyzer has
+ -- previously notified the violation of this restriction.
+
or else Restriction_Active (No_Dispatching_Calls)
then
return;
Timeval_Forever : constant := 1.0 * SOSC.MAX_tv_sec;
Forever : constant Duration :=
Duration'Min (Duration'Last, Timeval_Forever);
-
subtype Timeval_Duration is Duration range Immediate .. Forever;
+ -- These needs commenting, in particular we should explain what these is
+ -- used for, and how the Timeval_Forever value is chosen (see r176463) ???
subtype Selector_Duration is Timeval_Duration;
-- Timeout value for selector operations
static void
db_phases (int phases)
{
- phase_descriptor *a = phase_descriptors;
+ const phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes() & DB_PHASES))
return;
static void
get_action_description_for (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
+ _Unwind_Action uw_phase,
region_descriptor *region,
action_descriptor *action)
{
/* Positive filters are for regular handlers. */
else if (ar_filter > 0)
{
- /* See if the filter we have is for an exception which matches
- the one we are propagating. */
- _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
-
- if (is_handled_by (choice, gnat_exception))
- {
- action->kind = handler;
- action->ttype_filter = ar_filter;
- action->ttype_entry = choice;
- return;
- }
+ /* Do not catch an exception if the _UA_FORCE_UNWIND flag is
+ passed (to follow the ABI). */
+ if (!(uw_phase & _UA_FORCE_UNWIND))
+ {
+ /* See if the filter we have is for an exception which
+ matches the one we are propagating. */
+ _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
+
+ if (is_handled_by (choice, gnat_exception))
+ {
+ action->kind = handler;
+ action->ttype_filter = ar_filter;
+ action->ttype_entry = choice;
+ return;
+ }
+ }
}
/* Negative filter values are for C++ exception specifications.
/* Search the call-site and action-record tables for the action associated
with this IP. */
- get_action_description_for (uw_context, uw_exception, ®ion, &action);
+ get_action_description_for (uw_context, uw_exception, uw_phases,
+ ®ion, &action);
db_action_for (&action, uw_context);
/* Whatever the phase, if there is nothing relevant in this frame,
-- Taft amemdment types are identified.
if Ekind (Scope (Current_Scope)) = E_Package
- and then
- In_Private_Part (Scope (Current_Scope))
+ and then In_Private_Part (Scope (Current_Scope))
then
Append_Elmt (Designator, Private_Dependents (Typ));
end if;
or else not Is_Primitive_Wrapper (New_Id)
then
Conformance_Error ("\mode of & does not match!", New_Formal);
+
else
declare
- T : constant Entity_Id :=
- Find_Dispatching_Type (New_Id);
+ T : constant Entity_Id := Find_Dispatching_Type (New_Id);
begin
if Is_Protected_Type
(Corresponding_Concurrent_Type (T))
and then Is_Protected_Type (Typ)
and then
(Is_Limited_Interface (Iface_Typ)
- or else Is_Protected_Interface (Iface_Typ)
- or else Is_Synchronized_Interface (Iface_Typ)
- or else Is_Task_Interface (Iface_Typ))
+ or else Is_Protected_Interface (Iface_Typ)
+ or else Is_Synchronized_Interface (Iface_Typ)
+ or else Is_Task_Interface (Iface_Typ))
then
Error_Msg_PT (Parent (Typ), Candidate);
end if;
end if;
-- Create corresponding record now, because some private dependents
- -- may be subtypes of the partial view. Skip if errors are present,
- -- to prevent cascaded messages.
+ -- may be subtypes of the partial view.
+
+ -- Skip if errors are present, to prevent cascaded messages
if Serious_Errors_Detected = 0
+
+ -- Also skip if expander is not active
+
and then Expander_Active
+
+ -- Also skip if in ALFA mode, this expansion is not needed
+
and then not ALFA_Mode
then
Expand_N_Protected_Type_Declaration (N);
end if;
-- Create corresponding record now, because some private dependents
- -- may be subtypes of the partial view. Skip if errors are present,
- -- to prevent cascaded messages.
+ -- may be subtypes of the partial view.
+
+ -- Skip if errors are present, to prevent cascaded messages
if Serious_Errors_Detected = 0
+
+ -- Also skip if expander is not active
+
and then Expander_Active
+
+ -- Or if in ALFA mode, this expansion is not needed
and then not ALFA_Mode
then
Expand_N_Task_Type_Declaration (N);
-- conversions from an anonymous access type to a named general
-- access type. Such conversions are not allowed in the case of
-- access parameters and stand-alone objects of an anonymous
- -- access type.
+ -- access type. The implicit conversion case is recognized by
+ -- testing that Comes_From_Source is False and that it's been
+ -- rewritten. The Comes_From_Source test isn't sufficient because
+ -- nodes in inlined calls to predefined library routines can have
+ -- Comes_From_Source set to False. (Is there a better way to test
+ -- for implicit conversions???)
if Ada_Version >= Ada_2012
and then not Comes_From_Source (N)
+ and then N /= Original_Node (N)
and then Ekind (Target_Type) = E_General_Access_Type
and then Ekind (Opnd_Type) = E_Anonymous_Access_Type
then
or else K = E_In_Out_Parameter
or else K = E_Generic_In_Out_Parameter
- -- Current instance of type:
+ -- Current instance of type
or else (Is_Type (E) and then In_Open_Scopes (E))
or else (Is_Incomplete_Or_Private_Type (E)
Kill_Current_Values_For_Entity_Chain (First_Entity (S));
- -- If scope is a package, also clear current values of all
- -- private entities in the scope.
+ -- If scope is a package, also clear current values of all private
+ -- entities in the scope.
if Is_Package_Or_Generic_Package (S)
or else Is_Concurrent_Type (S)
-- is an lvalue, but the prefix is never an lvalue, since it is just
-- the scope where the name is found.
- when N_Expanded_Name =>
+ when N_Expanded_Name =>
if N = Prefix (P) then
return May_Be_Lvalue (P);
else
-- it is. Note however that A is not an lvalue if it is of an access
-- type since this is an implicit dereference.
- when N_Selected_Component =>
+ when N_Selected_Component =>
if N = Prefix (P)
and then Present (Etype (N))
and then Is_Access_Type (Etype (N))
-- or slice is an lvalue, except if it is an access type, where we
-- have an implicit dereference.
- when N_Indexed_Component | N_Slice =>
+ when N_Indexed_Component | N_Slice =>
if N /= Prefix (P)
or else (Present (Etype (N)) and then Is_Access_Type (Etype (N)))
then
-- Prefix of a reference is an lvalue if the reference is an lvalue
- when N_Reference =>
+ when N_Reference =>
return May_Be_Lvalue (P);
-- Prefix of explicit dereference is never an lvalue
N_Entry_Call_Statement |
N_Accept_Statement
=>
- if Nkind (P) = N_Function_Call
- and then Ada_Version < Ada_2012
- then
+ if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then
return False;
end if;
- -- The following mechanism is clumsy and fragile. A single
- -- flag set in Resolve_Actuals would be preferable ???
+ -- The following mechanism is clumsy and fragile. A single flag
+ -- set in Resolve_Actuals would be preferable ???
declare
Proc : Entity_Id;
return True;
end if;
- -- If we are not a list member, something is strange, so
- -- be conservative and return True.
+ -- If we are not a list member, something is strange, so be
+ -- conservative and return True.
if not Is_List_Member (N) then
return True;
Form := First_Formal (Proc);
Act := N;
loop
- -- If no formal, something is weird, so be conservative
- -- and return True.
+ -- If no formal, something is weird, so be conservative and
+ -- return True.
if No (Form) then
return True;
OSDN Git Service
