[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:
parent
68f640f221
commit
fcf848c4f7
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 :=
|
||||
Nkind_In (N, N_Package_Body, N_Package_Specification);
|
||||
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;
|
||||
|
@ -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
|
||||
|
@ -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#" &
|
||||
|
@ -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 " &
|
||||
|
@ -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 ???
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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 + $;
|
||||
|
Loading…
Reference in New Issue
Block a user