[multiple changes]

2009-04-17  Thomas Quinot  <quinot@adacore.com>

	* 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  <charlet@adacore.com>

	* 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

11 files changed, 120 insertions, 28 deletions

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  <quinot@adacore.com>
 
+	* 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  <duff@adacore.com>
+
+	* 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  <charlet@adacore.com>
+
+	* 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  <quinot@adacore.com>
+
 	* exp_aggr.adb: Minor code reorganization, no behaviour change.
 
 2009-04-17  Ed Schonberg  <schonberg@adacore.com>
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);