[multiple changes]

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Actuals): If an actual is the current instance of
	a task type, it must be replaced with a reference to Self.

2010-10-11  Vincent Celier  <celier@adacore.com>

	* adaint.h: Add prototype for function __gnat_create_output_file_new.

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* sem_aggr.adb (Collect_Aggr_Bounds): Remove side effects of collected
	aggregate bounds.

From-SVN: r165280
This commit is contained in:
Arnaud Charlet 2010-10-11 10:48:19 +02:00
parent 313d6f2c34
commit fb468a944c
4 changed files with 41 additions and 3 deletions

View File

@ -1,3 +1,17 @@
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Actuals): If an actual is the current instance of
a task type, it must be replaced with a reference to Self.
2010-10-11 Vincent Celier <celier@adacore.com>
* adaint.h: Add prototype for function __gnat_create_output_file_new.
2010-10-11 Javier Miranda <miranda@adacore.com>
* sem_aggr.adb (Collect_Aggr_Bounds): Remove side effects of collected
aggregate bounds.
2010-10-11 Arnaud Charlet <charlet@adacore.com> 2010-10-11 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Check_Interrupt_Or_Attach_Handler): Do not emit error * sem_prag.adb (Check_Interrupt_Or_Attach_Handler): Do not emit error

View File

@ -131,6 +131,8 @@ extern int __gnat_open_read (char *, int);
extern int __gnat_open_rw (char *, int); extern int __gnat_open_rw (char *, int);
extern int __gnat_open_create (char *, int); extern int __gnat_open_create (char *, int);
extern int __gnat_create_output_file (char *); extern int __gnat_create_output_file (char *);
extern int __gnat_create_output_file_new (char *);
extern int __gnat_open_append (char *, int); extern int __gnat_open_append (char *, int);
extern long __gnat_file_length (int); extern long __gnat_file_length (int);
extern long __gnat_named_file_length (char *); extern long __gnat_named_file_length (char *);

View File

@ -1654,6 +1654,24 @@ package body Exp_Ch6 is
elsif Is_Possibly_Unaligned_Slice (Actual) then elsif Is_Possibly_Unaligned_Slice (Actual) then
Add_Call_By_Copy_Code; Add_Call_By_Copy_Code;
-- An unusual case: a current instance of an enclosing task can be
-- an actual, and must be replaced by a reference to self.
elsif Is_Entity_Name (Actual)
and then Is_Task_Type (Entity (Actual))
then
if In_Open_Scopes (Entity (Actual)) then
Rewrite (Actual,
(Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Self), Loc))));
Analyze (Actual);
-- A task type cannot otherwise appear as an actual
else
raise Program_Error;
end if;
end if; end if;
end if; end if;

View File

@ -526,9 +526,10 @@ package body Sem_Aggr is
Is_Fully_Positional : Boolean := True; Is_Fully_Positional : Boolean := True;
procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos); procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos);
-- N is an array (sub-)aggregate. Dim is the dimension corresponding to -- N is an array (sub-)aggregate. Dim is the dimension corresponding
-- (sub-)aggregate N. This procedure collects the constrained N_Range -- to (sub-)aggregate N. This procedure collects and removes the side
-- nodes corresponding to each index dimension of our aggregate itype. -- effects of the constrained N_Range nodes corresponding to each index
-- dimension of our aggregate itype.
-- These N_Range nodes are collected in Aggr_Range above. -- These N_Range nodes are collected in Aggr_Range above.
-- --
-- Likewise collect in Aggr_Low & Aggr_High above the low and high -- Likewise collect in Aggr_Low & Aggr_High above the low and high
@ -552,6 +553,9 @@ package body Sem_Aggr is
Expr : Node_Id; Expr : Node_Id;
begin begin
Remove_Side_Effects (This_Low, Variable_Ref => True);
Remove_Side_Effects (This_High, Variable_Ref => True);
-- Collect the first N_Range for a given dimension that you find. -- Collect the first N_Range for a given dimension that you find.
-- For a given dimension they must be all equal anyway. -- For a given dimension they must be all equal anyway.