diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-30 16:01:42 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-30 16:01:42 +0200 |
commit | c199ccf75867fa7287570ff1ec19ef76cc9d5ea6 (patch) | |
tree | 1ba170de5f902002c4ad31be1aa6f3986ada28bf /gcc | |
parent | dff99e1a52a750cb5c1be4e5f0ccb1567e0ca015 (diff) | |
download | gcc-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/ChangeLog | 21 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 14 | ||||
-rw-r--r-- | gcc/ada/exp_disp.adb | 14 | ||||
-rw-r--r-- | gcc/ada/g-socket.ads | 3 | ||||
-rw-r--r-- | gcc/ada/raise-gcc.c | 33 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_ch9.adb | 21 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 30 |
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, ®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, 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; |