[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

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;