[multiple changes]

2012-04-26  Robert Dewar  <dewar@adacore.com>

	* exp_aggr.adb: Minor reformatting.

2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Expand_Cleanup_Actions): Update the call to
	Requires_Cleanup_Actions.
	* exp_util.adb (Requires_Cleanup_Actions (List_Id; Boolean;
	Boolean)): Rename formal parameter For_Package to Lib_Level to
	better reflect its purpose. Update the related comment and all
	occurrences of For_Package in the body.
	(Requires_Cleanup_Actions
	(Node_Id; Boolean)): Add new formal parameter Lib_Level. Add
	local constant At_Lib_Level to keep monitor whether the path
	taken from the top-most context to the current construct involves
	package constructs. Update all calls to Requires_Cleanup_Actions.
	* exp_util.ads (Requires_Cleanup_Actions): Add new formal
	parameter Lib_Level and associated comment.

2012-04-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): If the type of the formal is
	a non null access type, mark the generated subtype as having a
	delayed freeze only if the designated type is not frozen yet.

2012-04-26  Vincent Celier  <celier@adacore.com>

	* prj-attr.adb: New package Clean with attributes
	Object_Artifact_Extensions and Source_Artifact_Extensions.
	* prj-nmsc.adb (Process_Clean): Process new package Clean
	* prj.ads (Language_Config): New components
	Clean_Object_Artifacts and Clean_Source_Artifacts.
	* snames.ads-tmpl: New standard names Clean,
	Object_Artifact_Extensions and Source_Artifact_Extensions.

From-SVN: r186867
This commit is contained in:
Arnaud Charlet 2012-04-26 11:49:04 +02:00
parent 68f640f221
commit fcf848c4f7
10 changed files with 175 additions and 34 deletions

View File

@ -1,3 +1,39 @@
2012-04-26 Robert Dewar <dewar@adacore.com>
* exp_aggr.adb: Minor reformatting.
2012-04-26 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Expand_Cleanup_Actions): Update the call to
Requires_Cleanup_Actions.
* exp_util.adb (Requires_Cleanup_Actions (List_Id; Boolean;
Boolean)): Rename formal parameter For_Package to Lib_Level to
better reflect its purpose. Update the related comment and all
occurrences of For_Package in the body.
(Requires_Cleanup_Actions
(Node_Id; Boolean)): Add new formal parameter Lib_Level. Add
local constant At_Lib_Level to keep monitor whether the path
taken from the top-most context to the current construct involves
package constructs. Update all calls to Requires_Cleanup_Actions.
* exp_util.ads (Requires_Cleanup_Actions): Add new formal
parameter Lib_Level and associated comment.
2012-04-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Process_Formals): If the type of the formal is
a non null access type, mark the generated subtype as having a
delayed freeze only if the designated type is not frozen yet.
2012-04-26 Vincent Celier <celier@adacore.com>
* prj-attr.adb: New package Clean with attributes
Object_Artifact_Extensions and Source_Artifact_Extensions.
* prj-nmsc.adb (Process_Clean): Process new package Clean
* prj.ads (Language_Config): New components
Clean_Object_Artifacts and Clean_Source_Artifacts.
* snames.ads-tmpl: New standard names Clean,
Object_Artifact_Extensions and Source_Artifact_Extensions.
2012-04-26 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Proper_First_Index): Moved from Sem_Util.

View File

@ -6030,10 +6030,10 @@ package body Exp_Aggr is
end if;
-- At this stage we have a suitable aggregate for handling at compile
-- time (the only remaining checks are that the values of expressions
-- in the aggregate are compile-time known, checks are performed by
-- time. The only remaining checks are that the values of expressions
-- in the aggregate are compile-time known (checks are performed by
-- Get_Component_Val, and that any subtypes or ranges are statically
-- known).
-- known.
-- If the aggregate is not fully positional at this stage, then
-- convert it to positional form. Either this will fail, in which

View File

@ -3599,7 +3599,7 @@ package body Exp_Ch7 is
and then VM_Target = No_VM;
Actions_Required : constant Boolean :=
Requires_Cleanup_Actions (N)
Requires_Cleanup_Actions (N, True)
or else Is_Asynchronous_Call
or else Is_Master
or else Is_Protected_Body

View File

@ -150,16 +150,16 @@ package body Exp_Util is
function Requires_Cleanup_Actions
(L : List_Id;
For_Package : Boolean;
Lib_Level : Boolean;
Nested_Constructs : Boolean) return Boolean;
-- Given a list L, determine whether it contains one of the following:
--
-- 1) controlled objects
-- 2) library-level tagged types
--
-- Flag For_Package should be set when the list comes from a package spec
-- or body. Flag Nested_Constructs should be set when any nested packages
-- declared in L must be processed.
-- Flag Lib_Level should be set when the list comes from a construct at
-- the library level. Flag Nested_Constructs should be set when any nested
-- packages declared in L must be processed.
-------------------------------------
-- Activate_Atomic_Synchronization --
@ -7038,9 +7038,14 @@ package body Exp_Util is
-- Requires_Cleanup_Actions --
------------------------------
function Requires_Cleanup_Actions (N : Node_Id) return Boolean is
For_Pkg : constant Boolean :=
function Requires_Cleanup_Actions
(N : Node_Id;
Lib_Level : Boolean) return Boolean
is
At_Lib_Level : constant Boolean := Lib_Level and then
Nkind_In (N, N_Package_Body, N_Package_Specification);
-- N is at the library level if the top-most context is a package and
-- the path taken to reach N does not inlcude non-package constructs.
begin
case Nkind (N) is
@ -7052,20 +7057,20 @@ package body Exp_Util is
N_Subprogram_Body |
N_Task_Body =>
return
Requires_Cleanup_Actions (Declarations (N), For_Pkg, True)
Requires_Cleanup_Actions (Declarations (N), At_Lib_Level, True)
or else
(Present (Handled_Statement_Sequence (N))
and then
Requires_Cleanup_Actions (Statements
(Handled_Statement_Sequence (N)), For_Pkg, True));
(Handled_Statement_Sequence (N)), At_Lib_Level, True));
when N_Package_Specification =>
return
Requires_Cleanup_Actions
(Visible_Declarations (N), For_Pkg, True)
(Visible_Declarations (N), At_Lib_Level, True)
or else
Requires_Cleanup_Actions
(Private_Declarations (N), For_Pkg, True);
(Private_Declarations (N), At_Lib_Level, True);
when others =>
return False;
@ -7078,7 +7083,7 @@ package body Exp_Util is
function Requires_Cleanup_Actions
(L : List_Id;
For_Package : Boolean;
Lib_Level : Boolean;
Nested_Constructs : Boolean) return Boolean
is
Decl : Node_Id;
@ -7125,9 +7130,7 @@ package body Exp_Util is
-- finalization disabled. This applies only to objects at the
-- library level.
if For_Package
and then Finalize_Storage_Only (Obj_Typ)
then
if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null;
-- Transient variables are treated separately in order to minimize
@ -7203,9 +7206,7 @@ package body Exp_Util is
-- finalization disabled. This applies only to objects at the
-- library level.
if For_Package
and then Finalize_Storage_Only (Obj_Typ)
then
if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
null;
-- Return object of a build-in-place function. This case is
@ -7257,7 +7258,7 @@ package body Exp_Util is
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), For_Package, Nested_Constructs)
(Actions (Decl), Lib_Level, Nested_Constructs)
then
return True;
end if;
@ -7274,7 +7275,8 @@ package body Exp_Util is
end if;
if Ekind (Pack_Id) /= E_Generic_Package
and then Requires_Cleanup_Actions (Specification (Decl))
and then Requires_Cleanup_Actions
(Specification (Decl), Lib_Level)
then
return True;
end if;
@ -7287,7 +7289,7 @@ package body Exp_Util is
Pack_Id := Corresponding_Spec (Decl);
if Ekind (Pack_Id) /= E_Generic_Package
and then Requires_Cleanup_Actions (Decl)
and then Requires_Cleanup_Actions (Decl, Lib_Level)
then
return True;
end if;

View File

@ -744,14 +744,17 @@ package Exp_Util is
-- terms is scalar. This is true for scalars in the Ada sense, and for
-- packed arrays which are represented by a scalar (modular) type.
function Requires_Cleanup_Actions (N : Node_Id) return Boolean;
function Requires_Cleanup_Actions
(N : Node_Id;
Lib_Level : Boolean) return Boolean;
-- Given a node N, determine whether its declarative and/or statement list
-- contains one of the following:
--
-- 1) controlled objects
-- 2) library-level tagged types
--
-- The above cases require special actions on scope exit.
-- The above cases require special actions on scope exit. Flag Lib_Level
-- is used to track whether a construct is at the library level.
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
-- Given the node for an N_Unchecked_Type_Conversion, return True if this

View File

@ -281,6 +281,13 @@ package body Prj.Attr is
"SVresponse_file_format#" &
"LVresponse_file_switches#" &
-- package Clean
"Pclean#" &
"LVswitches#" &
"Lasource_artifact_extensions#" &
"Laobject_artifact_extensions#" &
-- package Cross_Reference
"Pcross_reference#" &

View File

@ -1101,6 +1101,9 @@ package body Prj.Nmsc is
procedure Process_Builder (Attributes : Variable_Id);
-- Process the simple attributes of package Builder
procedure Process_Clean (Arrays : Array_Id);
-- Process the associate array attributes of package Clean
procedure Process_Compiler (Arrays : Array_Id);
-- Process the associate array attributes of package Compiler
@ -1223,6 +1226,71 @@ package body Prj.Nmsc is
end loop;
end Process_Builder;
-------------------
-- Process_Clean --
-------------------
procedure Process_Clean (Arrays : Array_Id) is
Current_Array_Id : Array_Id;
Current_Array : Array_Data;
Element_Id : Array_Element_Id;
Element : Array_Element;
List : String_List_Id;
begin
-- Process the associative array attribute of package Clean
Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop
Current_Array := Shared.Arrays.Table (Current_Array_Id);
Element_Id := Current_Array.Value;
while Element_Id /= No_Array_Element loop
Element := Shared.Array_Elements.Table (Element_Id);
-- Get the name of the language
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
-- Attribute Object_Artifact_Extensions (<language>)
when Name_Object_Artifact_Extensions =>
List := Element.Value.Values;
if List /= Nil_String then
Put (Into_List =>
Lang_Index.Config.Clean_Object_Artifacts,
From_List => List,
In_Tree => Data.Tree);
end if;
-- Attribute Source_Artifact_Extensions (<language>)
when Name_Source_Artifact_Extensions =>
List := Element.Value.Values;
if List /= Nil_String then
Put (Into_List =>
Lang_Index.Config.Clean_Source_Artifacts,
From_List => List,
In_Tree => Data.Tree);
end if;
when others =>
null;
end case;
end if;
Element_Id := Element.Next;
end loop;
Current_Array_Id := Current_Array.Next;
end loop;
end Process_Clean;
----------------------
-- Process_Compiler --
----------------------
@ -1832,6 +1900,12 @@ package body Prj.Nmsc is
Process_Builder (Element.Decl.Attributes);
when Name_Clean =>
-- Process attributes of package Clean
Process_Clean (Element.Decl.Arrays);
when Name_Compiler =>
-- Process attributes of package Compiler
@ -3217,7 +3291,9 @@ package body Prj.Nmsc is
if Project.Library then
Support_For_Libraries := Project.Config.Lib_Support;
if Support_For_Libraries = Prj.None then
if not Project.Externally_Built and then
Support_For_Libraries = Prj.None
then
Error_Msg
(Data.Flags,
"?libraries are not supported on this platform",
@ -3405,7 +3481,9 @@ package body Prj.Nmsc is
end if;
if Project.Library_Kind /= Static then
if Support_For_Libraries = Prj.Static_Only then
if not Project.Externally_Built and then
Support_For_Libraries = Prj.Static_Only
then
Error_Msg
(Data.Flags,
"only static libraries are supported " &

View File

@ -606,6 +606,12 @@ package Prj is
Toolchain_Description : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Description for the language
Clean_Object_Artifacts : Name_List_Index := No_Name_List;
-- List of object artifact extensions to be deleted by gprclean
Clean_Source_Artifacts : Name_List_Index := No_Name_List;
-- List of source artifact extensions to be deleted by gprclean
end record;
No_Language_Config : constant Language_Config :=
@ -654,7 +660,9 @@ package Prj is
Binder_Required_Switches => No_Name_List,
Binder_Prefix => No_Name,
Toolchain_Version => No_Name,
Toolchain_Description => No_Name);
Toolchain_Description => No_Name,
Clean_Object_Artifacts => No_Name_List,
Clean_Source_Artifacts => No_Name_List);
-- The following record ???

View File

@ -10813,15 +10813,19 @@ package body Sem_Ch6 is
Related_Nod => Related_Nod,
Scope_Id => Scope (Current_Scope));
-- If the designated type of the itype is an itype we
-- decorate it with the Has_Delayed_Freeze attribute to
-- avoid problems with the backend.
-- If the designated type of the itype is an itype that is
-- not frozen yet, we set the Has_Delayed_Freeze attribute
-- on the access subtype, to prevent order-of-elaboration
-- issues in the backend.
-- Example:
-- type T is access procedure;
-- procedure Op (O : not null T);
if Is_Itype (Directly_Designated_Type (Formal_Type)) then
if Is_Itype (Directly_Designated_Type (Formal_Type))
and then
not Is_Frozen (Directly_Designated_Type (Formal_Type))
then
Set_Has_Delayed_Freeze (Formal_Type);
end if;
end if;

View File

@ -1106,6 +1106,7 @@ package Snames is
Name_Binder : constant Name_Id := N + $;
Name_Body_Suffix : constant Name_Id := N + $;
Name_Builder : constant Name_Id := N + $;
Name_Clean : constant Name_Id := N + $;
Name_Compiler : constant Name_Id := N + $;
Name_Compiler_Command : constant Name_Id := N + $; -- GB
Name_Config_Body_File_Name : constant Name_Id := N + $;
@ -1195,6 +1196,7 @@ package Snames is
Name_Multi_Unit_Switches : constant Name_Id := N + $;
Name_Naming : constant Name_Id := N + $;
Name_None : constant Name_Id := N + $;
Name_Object_Artifact_Extensions : constant Name_Id := N + $;
Name_Object_File_Suffix : constant Name_Id := N + $;
Name_Object_File_Switches : constant Name_Id := N + $;
Name_Object_Generated : constant Name_Id := N + $;
@ -1224,6 +1226,7 @@ package Snames is
Name_Shared_Library_Prefix : constant Name_Id := N + $;
Name_Shared_Library_Suffix : constant Name_Id := N + $;
Name_Separate_Suffix : constant Name_Id := N + $;
Name_Source_Artifact_Extensions : constant Name_Id := N + $;
Name_Source_Dirs : constant Name_Id := N + $;
Name_Source_File_Switches : constant Name_Id := N + $;
Name_Source_Files : constant Name_Id := N + $;