* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146254
138bc75d-0d04-0410-961f-
82ee72b054a4
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>
-- 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
-- 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;
-- 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;
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.
-- 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
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);
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);
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);
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);
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);
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);
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);
OSDN Git Service
