[multiple changes]
2009-05-06 Gary Dismukes <dismukes@adacore.com> * sem_aggr.adb: Fix typo. 2009-05-06 Thomas Quinot <quinot@adacore.com> * exp_ch3.adb (Expand_N_Object_Declaration): For a controlled object declaration, do not adjust if the declaration is to be rewritten into a renaming. 2009-05-06 Ed Schonberg <schonberg@adacore.com> * sem_ch8.adb (Find_Type): Reject the use of a task type in its own discriminant part. 2009-05-06 Bob Duff <duff@adacore.com> * s-fileio.adb (File_IO_Clean_Up_Type): Make this type limited, since otherwise the compiler would be allowed to optimize away the cleanup code. From-SVN: r147163
This commit is contained in:
parent
69a0c1741e
commit
e264efcc38
|
@ -1,3 +1,24 @@
|
||||||
|
2009-05-06 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
|
* sem_aggr.adb: Fix typo.
|
||||||
|
|
||||||
|
2009-05-06 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch3.adb (Expand_N_Object_Declaration): For a controlled object
|
||||||
|
declaration, do not adjust if the declaration is to be rewritten into
|
||||||
|
a renaming.
|
||||||
|
|
||||||
|
2009-05-06 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch8.adb (Find_Type): Reject the use of a task type in its own
|
||||||
|
discriminant part.
|
||||||
|
|
||||||
|
2009-05-06 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
|
* s-fileio.adb (File_IO_Clean_Up_Type): Make this type limited, since
|
||||||
|
otherwise the compiler would be allowed to optimize away the cleanup
|
||||||
|
code.
|
||||||
|
|
||||||
2009-05-06 Gary Dismukes <dismukes@adacore.com>
|
2009-05-06 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
* gnat_ugn.texi: Fix typo.
|
* gnat_ugn.texi: Fix typo.
|
||||||
|
|
|
@ -1888,8 +1888,8 @@ package body Exp_Ch3 is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Needs_Finalization (Typ)
|
if Needs_Finalization (Typ)
|
||||||
and then not (Kind = N_Aggregate or else Kind = N_Extension_Aggregate)
|
and then not (Nkind_In (Kind, N_Aggregate, N_Extension_Aggregate))
|
||||||
and then not Is_Inherently_Limited_Type (Typ)
|
and then not Is_Inherently_Limited_Type (Typ)
|
||||||
then
|
then
|
||||||
Append_List_To (Res,
|
Append_List_To (Res,
|
||||||
Make_Adjust_Call (
|
Make_Adjust_Call (
|
||||||
|
@ -4185,9 +4185,28 @@ package body Exp_Ch3 is
|
||||||
-- which case the init proc call must be inserted only after the bodies
|
-- which case the init proc call must be inserted only after the bodies
|
||||||
-- of the shared variable procedures have been seen.
|
-- of the shared variable procedures have been seen.
|
||||||
|
|
||||||
|
function Rewrite_As_Renaming return Boolean;
|
||||||
|
-- Indicate whether to rewrite a declaration with initialization into an
|
||||||
|
-- object renaming declaration (see below).
|
||||||
|
|
||||||
|
-------------------------
|
||||||
|
-- Rewrite_As_Renaming --
|
||||||
|
-------------------------
|
||||||
|
|
||||||
|
function Rewrite_As_Renaming return Boolean is
|
||||||
|
begin
|
||||||
|
return not Aliased_Present (N)
|
||||||
|
and then Is_Entity_Name (Expr_Q)
|
||||||
|
and then Ekind (Entity (Expr_Q)) = E_Variable
|
||||||
|
and then OK_To_Rename (Entity (Expr_Q))
|
||||||
|
and then Is_Entity_Name (Object_Definition (N));
|
||||||
|
end Rewrite_As_Renaming;
|
||||||
|
|
||||||
|
-- Start of processing for Expand_N_Object_Declaration
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Don't do anything for deferred constants. All proper actions will
|
-- Don't do anything for deferred constants. All proper actions will be
|
||||||
-- be expanded during the full declaration.
|
-- expanded during the full declaration.
|
||||||
|
|
||||||
if No (Expr) and Constant_Present (N) then
|
if No (Expr) and Constant_Present (N) then
|
||||||
return;
|
return;
|
||||||
|
@ -4603,10 +4622,13 @@ package body Exp_Ch3 is
|
||||||
-- where the object was initialized by a call to a function whose
|
-- where the object was initialized by a call to a function whose
|
||||||
-- result is built in place, since no copy occurred. (Eventually
|
-- result is built in place, since no copy occurred. (Eventually
|
||||||
-- we plan to support in-place function results for some cases
|
-- we plan to support in-place function results for some cases
|
||||||
-- of nonlimited types. ???)
|
-- of nonlimited types. ???) Similarly, no adjustment is required
|
||||||
|
-- if we are going to rewrite the object declaration into a
|
||||||
|
-- renaming declaration.
|
||||||
|
|
||||||
if Needs_Finalization (Typ)
|
if Needs_Finalization (Typ)
|
||||||
and then not Is_Inherently_Limited_Type (Typ)
|
and then not Is_Inherently_Limited_Type (Typ)
|
||||||
|
and then not Rewrite_As_Renaming
|
||||||
then
|
then
|
||||||
Insert_Actions_After (Init_After,
|
Insert_Actions_After (Init_After,
|
||||||
Make_Adjust_Call (
|
Make_Adjust_Call (
|
||||||
|
@ -4750,14 +4772,11 @@ package body Exp_Ch3 is
|
||||||
-- X : typ renames expr
|
-- X : typ renames expr
|
||||||
|
|
||||||
-- provided that X is not aliased. The aliased case has to be
|
-- provided that X is not aliased. The aliased case has to be
|
||||||
-- excluded in general because expr will not be aliased in general.
|
-- excluded in general because Expr will not be aliased in general.
|
||||||
|
-- We also exclude controlled types because X and Expr may need to
|
||||||
|
-- be attached to distinct finalization lists.
|
||||||
|
|
||||||
if not Aliased_Present (N)
|
if Rewrite_As_Renaming then
|
||||||
and then Is_Entity_Name (Expr_Q)
|
|
||||||
and then Ekind (Entity (Expr_Q)) = E_Variable
|
|
||||||
and then OK_To_Rename (Entity (Expr_Q))
|
|
||||||
and then Is_Entity_Name (Object_Definition (N))
|
|
||||||
then
|
|
||||||
Rewrite (N,
|
Rewrite (N,
|
||||||
Make_Object_Renaming_Declaration (Loc,
|
Make_Object_Renaming_Declaration (Loc,
|
||||||
Defining_Identifier => Defining_Identifier (N),
|
Defining_Identifier => Defining_Identifier (N),
|
||||||
|
|
|
@ -73,12 +73,12 @@ package body System.File_IO is
|
||||||
-- Points to list of names of temporary files. Note that this global
|
-- Points to list of names of temporary files. Note that this global
|
||||||
-- variable must be properly protected to provide thread safety.
|
-- variable must be properly protected to provide thread safety.
|
||||||
|
|
||||||
type File_IO_Clean_Up_Type is new Controlled with null record;
|
type File_IO_Clean_Up_Type is new Limited_Controlled with null record;
|
||||||
-- The closing of all open files and deletion of temporary files is an
|
-- The closing of all open files and deletion of temporary files is an
|
||||||
-- action which takes place at the end of execution of the main program.
|
-- action that takes place at the end of execution of the main program.
|
||||||
-- This action can be implemented using a library level object which
|
-- This action is implemented using a library level object which gets
|
||||||
-- gets finalized at the end of the main program execution. The above is
|
-- finalized at the end of program execution. Note that the type should be
|
||||||
-- a controlled type introduced for this purpose.
|
-- limited, in order to avoid unwanted optimizations.
|
||||||
|
|
||||||
procedure Finalize (V : in out File_IO_Clean_Up_Type);
|
procedure Finalize (V : in out File_IO_Clean_Up_Type);
|
||||||
-- This is the finalize operation that is used to do the cleanup
|
-- This is the finalize operation that is used to do the cleanup
|
||||||
|
|
|
@ -3076,10 +3076,14 @@ package body Sem_Aggr is
|
||||||
-- of all ancestors, starting with the root.
|
-- of all ancestors, starting with the root.
|
||||||
|
|
||||||
if Nkind (N) = N_Extension_Aggregate then
|
if Nkind (N) = N_Extension_Aggregate then
|
||||||
|
|
||||||
|
-- If the ancestor part is a C++ constructor we must handle
|
||||||
|
-- here that it is a function returning a class-wide type
|
||||||
|
|
||||||
if Is_CPP_Constructor_Call (Ancestor_Part (N)) then
|
if Is_CPP_Constructor_Call (Ancestor_Part (N)) then
|
||||||
pragma Assert
|
pragma Assert
|
||||||
(Is_Class_Wide_Type (Etype (Ancestor_Part (N))));
|
(Is_Class_Wide_Type (Etype (Ancestor_Part (N))));
|
||||||
Root_Typ := Base_Type (Etype (Etype (Ancestor_Part (N))));
|
Root_Typ := Root_Type (Etype (Ancestor_Part (N)));
|
||||||
else
|
else
|
||||||
Root_Typ := Base_Type (Etype (Ancestor_Part (N)));
|
Root_Typ := Base_Type (Etype (Ancestor_Part (N)));
|
||||||
end if;
|
end if;
|
||||||
|
@ -3462,7 +3466,7 @@ package body Sem_Aggr is
|
||||||
(Inner_Comp, New_Aggr,
|
(Inner_Comp, New_Aggr,
|
||||||
Component_Associations (Aggr));
|
Component_Associations (Aggr));
|
||||||
|
|
||||||
-- Collect disciminant values and recurse
|
-- Collect discriminant values and recurse
|
||||||
|
|
||||||
Add_Discriminant_Values
|
Add_Discriminant_Values
|
||||||
(New_Aggr, Assoc_List);
|
(New_Aggr, Assoc_List);
|
||||||
|
|
|
@ -5722,14 +5722,25 @@ package body Sem_Ch8 is
|
||||||
if Ekind (Base_Type (T_Name)) = E_Task_Type then
|
if Ekind (Base_Type (T_Name)) = E_Task_Type then
|
||||||
|
|
||||||
-- In Ada 2005, a task name can be used in an access
|
-- In Ada 2005, a task name can be used in an access
|
||||||
-- definition within its own body.
|
-- definition within its own body. It cannot be used
|
||||||
|
-- in the discriminant part of the task declaration,
|
||||||
|
-- nor anywhere else in the declaration because entries
|
||||||
|
-- cannot have access parameters.
|
||||||
|
|
||||||
if Ada_Version >= Ada_05
|
if Ada_Version >= Ada_05
|
||||||
and then Nkind (Parent (N)) = N_Access_Definition
|
and then Nkind (Parent (N)) = N_Access_Definition
|
||||||
then
|
then
|
||||||
Set_Entity (N, T_Name);
|
Set_Entity (N, T_Name);
|
||||||
Set_Etype (N, T_Name);
|
Set_Etype (N, T_Name);
|
||||||
return;
|
|
||||||
|
if Has_Completion (T_Name) then
|
||||||
|
return;
|
||||||
|
|
||||||
|
else
|
||||||
|
Error_Msg_N
|
||||||
|
("task type cannot be used as type mark " &
|
||||||
|
"within its own declaration", N);
|
||||||
|
end if;
|
||||||
|
|
||||||
else
|
else
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
|
|
Loading…
Reference in New Issue