From: Arnaud Charlet Date: Fri, 17 Apr 2009 12:12:07 +0000 (+0200) Subject: [multiple changes] X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a8f59a33dc5af78faf21f1afb48358ae1918926d;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2009-04-17 Thomas Quinot * exp_ch7.adb (Expand_Ctrl_Function_Call): Remove incorrect special case for the case of an aggregate component, the attach call for the result is actually needed. * exp_aggr.adb (Backend_Processing_Possible): Backend processing for an array aggregate must be disabled if the component type requires controlled actions. * exp_ch3.adb: Minor reformatting 2009-04-17 Arnaud Charlet * s-taprop-tru64.adb, s-taprop-vms.adb, s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-posix.adb (Suspend_Until_True): Protect against early wakeup. From-SVN: r146254 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 67f4c53..45c6cad 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,44 @@ 2009-04-17 Thomas Quinot + * exp_ch7.adb (Expand_Ctrl_Function_Call): Remove incorrect special + case for the case of an aggregate component, the attach call for the + result is actually needed. + + * exp_aggr.adb (Backend_Processing_Possible): Backend processing for + an array aggregate must be disabled if the component type requires + controlled actions. + + * exp_ch3.adb: Minor reformatting + +2009-04-17 Bob Duff + + * output.ads (Indent,Outdent): New procedures for indenting the output. + (Write_Char): Correct comment -- LF _is_ allowed. + + * output.adb (Indent,Outdent): New procedures for indenting the output. + Keep track of the indentation level, and make sure it doesn't get too + high. + (Flush_Buffer): Insert spaces at the beginning of each line, if + indentation level is nonzero. + (Save_Output_Buffer,Restore_Output_Buffer): Save and restore the current + indentation level. + (Set_Standard_Error,Set_Standard_Output): Remove superfluous + "Next_Col := 1;". Flush_Buffer does that. + + * sem_ch6.adb, sem_ch7.adb (Debug_Flag_C): Reorganize the output + controlled by the -gnatdc switch. It now occurs on entry/exit to the + relevant analysis routines, and calls Indent/Outdent to make the + indentation reflect the nesting level. Add "helper" routines, since + otherwise lots of "return;" statements would skip the debugging output. + +2009-04-17 Arnaud Charlet + + * s-taprop-tru64.adb, s-taprop-vms.adb, s-taprop-linux.adb, + s-taprop-solaris.adb, s-taprop-irix.adb, s-taprop-hpux-dce.adb, + s-taprop-posix.adb (Suspend_Until_True): Protect against early wakeup. + +2009-04-17 Thomas Quinot + * exp_aggr.adb: Minor code reorganization, no behaviour change. 2009-04-17 Ed Schonberg diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 61fa790..0ed20d0 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -506,6 +506,8 @@ package body Exp_Aggr is -- 9. There cannot be any discriminated record components, since the -- back end cannot handle this complex case. + -- 10. No controlled actions need to be generated for components. + function Backend_Processing_Possible (N : Node_Id) return Boolean is Typ : constant Entity_Id := Etype (N); -- Typ is the correct constrained array subtype of the aggregate @@ -580,9 +582,9 @@ package body Exp_Aggr is -- Start of processing for Backend_Processing_Possible begin - -- Checks 2 (array must not be bit packed) + -- Checks 2 (array not bit packed) and 10 (no controlled actions) - if Is_Bit_Packed_Array (Typ) then + if Is_Bit_Packed_Array (Typ) or else Needs_Finalization (Typ) then return False; end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 570b1f8..242e5c4 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2061,9 +2061,9 @@ package body Exp_Ch3 is -- return O.Iface_Comp'Position; -- end Fxx; - ------------------------------ - -- Build_Offset_To_Top_Body -- - ------------------------------ + ---------------------------------- + -- Build_Offset_To_Top_Function -- + ---------------------------------- procedure Build_Offset_To_Top_Function (Iface_Comp : Entity_Id) is Body_Node : Node_Id; @@ -6858,8 +6858,7 @@ package body Exp_Ch3 is and then Is_Variable_Size_Record (Etype (Comp_Typ)) and then Chars (Tag_Comp) /= Name_uTag then - pragma Assert - (Present (DT_Offset_To_Top_Func (Tag_Comp))); + pragma Assert (Present (DT_Offset_To_Top_Func (Tag_Comp))); -- Issue error if Set_Dynamic_Offset_To_Top is not available in a -- configurable run-time environment. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index dc60648..ea05b24 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1401,20 +1401,6 @@ package body Exp_Ch7 is -- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3); - -- If the context is an array aggregate, the call will be expanded into - -- an assignment, and the attachment will be done when the aggregate - -- expansion is complete. See body of Exp_Aggr for the treatment of - -- other controlled components. - - if (Nkind (Parent (N)) = N_Aggregate - and then Is_Array_Type (Etype (Parent (N)))) - or else - (Nkind (Parent (N)) = N_Component_Association - and then Is_Array_Type (Etype (Parent (Parent (N))))) - then - return; - end if; - -- Case where type has controlled components if Has_Controlled_Component (Rtype) then diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 6288af5..07fcc9c 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -1068,7 +1068,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb index 2d38f6e..59297e9 100644 --- a/gcc/ada/s-taprop-irix.adb +++ b/gcc/ada/s-taprop-irix.adb @@ -1153,7 +1153,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index aebfcb6..b9c3c5e 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -1083,7 +1083,19 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + -- This should not happen on current implementation of pthread + -- under Linux, but POSIX does not guarantee it, so this may + -- change in the future. + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index d87b1e6..c8894d6 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -1257,7 +1257,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 795750b..bd24700 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -1818,7 +1818,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb index 4c55c58..20b0bbc 100644 --- a/gcc/ada/s-taprop-tru64.adb +++ b/gcc/ada/s-taprop-tru64.adb @@ -1170,7 +1170,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access); diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 01a77d6..0d0dd08 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -1104,7 +1104,16 @@ package body System.Task_Primitives.Operations is S.State := False; else S.Waiting := True; - Result := pthread_cond_wait (S.CV'Access, S.L'Access); + + loop + -- loop in case pthread_cond_wait returns earlier than + -- expected (e.g. in case of EINTR caused by a signal). + + Result := pthread_cond_wait (S.CV'Access, S.L'Access); + pragma Assert (Result = 0 or else Result = EINTR); + + exit when not S.Waiting; + end loop; end if; Result := pthread_mutex_unlock (S.L'Access);