This new attribute, similar to 'Elab_Body for a subprogram is used only
in CodePeer mode, and corresponds to CodePeer's 'Elab_Subp_Body special
init procedure.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-29 Arnaud Charlet <char...@adacore.com>
* bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in
CodePeer mode.
* sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of
Attribute_Elab_Subp_Body.
* snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New.
* sem_util.adb: Update comments.
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 178155)
+++ exp_attr.adb (working copy)
@@ -1813,13 +1813,14 @@
-- and then the Elab_Body/Spec attribute is replaced by a reference
-- to this defining identifier.
- when Attribute_Elab_Body |
- Attribute_Elab_Spec =>
+ when Attribute_Elab_Body |
+ Attribute_Elab_Subp_Body |
+ Attribute_Elab_Spec =>
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
- if CodePeer_Mode then
+ if CodePeer_Mode or else Id = Attribute_Elab_Subp_Body then
return;
end if;
Index: bindgen.adb
===================================================================
--- bindgen.adb (revision 178155)
+++ bindgen.adb (working copy)
@@ -984,7 +984,12 @@
-- Case of no elaboration code
- elsif U.No_Elab then
+ elsif U.No_Elab
+ and then (not CodePeer_Mode
+ or else U.Utype = Is_Spec
+ or else U.Utype = Is_Spec_Only
+ or else U.Unit_Kind /= 's')
+ then
-- The only case in which we have to do something is if this
-- is a body, with a separate spec, where the separate spec
@@ -1019,10 +1024,7 @@
-- The uname_E increment is skipped if this is a separate spec,
-- since it will be done when we process the body.
- -- Ignore subprograms in CodePeer mode, since no useful
- -- elaboration subprogram is needed by CodePeer.
-
- elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then
+ else
Check_Elab_Flag :=
not CodePeer_Mode
and then (Force_Checking_Of_Elaboration_Flags
@@ -1055,12 +1057,18 @@
if Name_Buffer (Name_Len) = 's' then
Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
"'elab_spec";
+ Name_Len := Name_Len + 8;
+
+ elsif U.Unit_Kind = 's' and CodePeer_Mode then
+ Name_Buffer (Name_Len - 1 .. Name_Len + 13) :=
+ "'elab_subp_body";
+ Name_Len := Name_Len + 13;
+
else
Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
"'elab_body";
+ Name_Len := Name_Len + 8;
end if;
-
- Name_Len := Name_Len + 8;
end if;
Set_Casing (U.Icasing);
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 178157)
+++ sem_util.adb (working copy)
@@ -7584,9 +7584,9 @@
begin
-- Verify that prefix is analyzed and has the proper form. Note that
- -- the attributes Elab_Spec, Elab_Body, and UET_Address, which also
- -- produce the address of an entity, do not analyze their prefix
- -- because they denote entities that are not necessarily visible.
+ -- the attributes Elab_Spec, Elab_Body, Elab_Subp_Body and UET_Address,
+ -- which also produce the address of an entity, do not analyze their
+ -- prefix because they denote entities that are not necessarily visible.
-- Neither of them can apply to a protected type.
return Ada_Version >= Ada_2005
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 178155)
+++ sem_attr.adb (working copy)
@@ -1945,6 +1945,8 @@
and then
Aname /= Name_Elab_Spec
and then
+ Aname /= Name_Elab_Subp_Body
+ and then
Aname /= Name_UET_Address
and then
Aname /= Name_Enabled
@@ -3014,7 +3016,10 @@
-- Also handles processing for Elab_Spec
- when Attribute_Elab_Body | Attribute_Elab_Spec =>
+ when Attribute_Elab_Body |
+ Attribute_Elab_Spec |
+ Attribute_Elab_Subp_Body =>
+
Check_E0;
Check_Unit_Name (P);
Set_Etype (N, Standard_Void_Type);
@@ -7712,6 +7717,7 @@
Attribute_Elaborated |
Attribute_Elab_Body |
Attribute_Elab_Spec |
+ Attribute_Elab_Subp_Body |
Attribute_Enabled |
Attribute_External_Tag |
Attribute_Fast_Math |
Index: sem_attr.ads
===================================================================
--- sem_attr.ads (revision 178155)
+++ sem_attr.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -172,6 +172,17 @@
-- Ada code, e.g. if it is necessary to do selective reelaboration to
-- fix some error.
+ --------------------
+ -- Elab_Subp_Body --
+ --------------------
+
+ Attribute_Elab_Subp_Body => True,
+ -- This attribute can only be applied to a library level subprogram
+ -- name and is only relevant in CodePeer mode. It returns the entity
+ -- for the corresponding elaboration procedure for elaborating the body
+ -- of the referenced subprogram unit. This is used in the main generated
+ -- elaboration procedure by the binder in CodePeer mode only.
+
---------------
-- Elab_Spec --
---------------
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 178156)
+++ sem_ch6.adb (working copy)
@@ -1156,11 +1156,12 @@
end loop;
end if;
- -- Special processing for Elab_Spec and Elab_Body calls
+ -- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls
if Nkind (P) = N_Attribute_Reference
and then (Attribute_Name (P) = Name_Elab_Spec
- or else Attribute_Name (P) = Name_Elab_Body)
+ or else Attribute_Name (P) = Name_Elab_Body
+ or else Attribute_Name (P) = Name_Elab_Subp_Body)
then
if Present (Actuals) then
Error_Msg_N
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 178156)
+++ snames.ads-tmpl (working copy)
@@ -882,6 +882,7 @@
First_Entity_Attribute_Name : constant Name_Id := N + $;
Name_Elab_Body : constant Name_Id := N + $; -- GNAT
Name_Elab_Spec : constant Name_Id := N + $; -- GNAT
+ Name_Elab_Subp_Body : constant Name_Id := N + $; -- GNAT
Name_Storage_Pool : constant Name_Id := N + $;
-- These attributes are the ones that return types
@@ -1414,6 +1415,7 @@
Attribute_Elab_Body,
Attribute_Elab_Spec,
+ Attribute_Elab_Subp_Body,
Attribute_Storage_Pool,
-- Type attributes
