Skip to content

R
riscv-gcc-1
Commit c199ccf7 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r178310
parent dff99e1a
Showing with 101 additions and 56 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_ch9.adb
......@@ -2279,12 +2279,10 @@ package body Exp_Ch9 is
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.
......@@ -4909,7 +4907,6 @@ package body Exp_Ch9 is
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.
......@@ -4920,7 +4917,7 @@ package body Exp_Ch9 is
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
......@@ -11598,7 +11595,6 @@ package body Exp_Ch9 is
elsif Expander_Active
and then not ALFA_Mode
then
-- Associate discriminals with the first subprogram or entry body to
-- be expanded.
......
gcc/ada/exp_disp.adb
......@@ -695,14 +695,18 @@ package body Exp_Disp is
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;
......
gcc/ada/g-socket.ads
......@@ -435,8 +435,9 @@ package GNAT.Sockets is
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
......
gcc/ada/raise-gcc.c
......@@ -217,7 +217,7 @@ db (int db_code, char * msg_format, ...)
static void
db_phases (int phases)
{
phase_descriptor *a = phase_descriptors;
const phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes() & DB_PHASES))
return;
......@@ -901,6 +901,7 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
static void
get_action_description_for (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
_Unwind_Action uw_phase,
region_descriptor *region,
action_descriptor *action)
{
......@@ -965,17 +966,22 @@ get_action_description_for (_Unwind_Context *uw_context,
/* 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.
......@@ -1128,7 +1134,8 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
/* Search the call-site and action-record tables for the action associated
with this IP. */
get_action_description_for (uw_context, uw_exception, &region, &action);
get_action_description_for (uw_context, uw_exception, uw_phases,
&region, &action);
db_action_for (&action, uw_context);
/* Whatever the phase, if there is nothing relevant in this frame,
......
gcc/ada/sem_ch6.adb
......@@ -1601,8 +1601,7 @@ package body Sem_Ch6 is
-- 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;
......@@ -4241,10 +4240,10 @@ package body Sem_Ch6 is
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))
......@@ -8129,9 +8128,9 @@ package body Sem_Ch6 is
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;
......
gcc/ada/sem_ch9.adb
......@@ -1275,11 +1275,18 @@ package body Sem_Ch9 is
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);
......@@ -2079,11 +2086,17 @@ package body Sem_Ch9 is
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);
......
gcc/ada/sem_res.adb
......@@ -10648,10 +10648,16 @@ package body Sem_Res is
-- 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
......
gcc/ada/sem_util.adb
......@@ -8470,7 +8470,7 @@ package body Sem_Util is
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)
......@@ -8714,8 +8714,8 @@ package body Sem_Util is
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)
......@@ -9016,7 +9016,7 @@ package body Sem_Util is
-- 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
......@@ -9029,7 +9029,7 @@ package body Sem_Util is
-- 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))
......@@ -9044,7 +9044,7 @@ package body Sem_Util is
-- 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
......@@ -9055,7 +9055,7 @@ package body Sem_Util is
-- 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
......@@ -9072,14 +9072,12 @@ package body Sem_Util is
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;
......@@ -9093,8 +9091,8 @@ package body Sem_Util is
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;
......@@ -9106,8 +9104,8 @@ package body Sem_Util is
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;
......
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