summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-30 16:01:42 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-30 16:01:42 +0200
commitc199ccf75867fa7287570ff1ec19ef76cc9d5ea6 (patch)
tree1ba170de5f902002c4ad31be1aa6f3986ada28bf /gcc
parentdff99e1a52a750cb5c1be4e5f0ccb1567e0ca015 (diff)
downloadgcc-c199ccf75867fa7287570ff1ec19ef76cc9d5ea6.tar.gz
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog21
-rw-r--r--gcc/ada/exp_ch9.adb14
-rw-r--r--gcc/ada/exp_disp.adb14
-rw-r--r--gcc/ada/g-socket.ads3
-rw-r--r--gcc/ada/raise-gcc.c33
-rw-r--r--gcc/ada/sem_ch6.adb13
-rw-r--r--gcc/ada/sem_ch9.adb21
-rw-r--r--gcc/ada/sem_res.adb8
-rw-r--r--gcc/ada/sem_util.adb30
9 files changed, 101 insertions, 56 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fcb90dd9c3c..27462db9f40 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+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
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 9e5951af7f4..db76edddf79 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/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.
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index b4f4970c457..46db2dc192a 100644
--- a/gcc/ada/exp_disp.adb
+++ b/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;
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index c218b924ab0..0ac9889dd5b 100644
--- a/gcc/ada/g-socket.ads
+++ b/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
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 6ea59ae1990..729b76c25de 100644
--- a/gcc/ada/raise-gcc.c
+++ b/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,
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a5d6a1afab8..9fe7fdfa678 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/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;
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index e26707603e4..4757560c591 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/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);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c3d9ec96a17..3844ff713f5 100644
--- a/gcc/ada/sem_res.adb
+++ b/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
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4b48a5ab505..1cbadaa4d0f 100644
--- a/gcc/ada/sem_util.adb
+++ b/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;