The aspects Convention, Export, and Import are intended to replace the use of
the earlier pragmas by the same names. The additional aspects External_Name and
Link_Nmae provide the remaining functionality. which previously was provided by
additional pragma arguments.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-05-15 Ed Schonberg <schonb...@adacore.com>
* aspects.adb, aspects.ads: Add aspects for Convention, Export,
External_Name, Import, and Link_Name.
* exp_prag.adb (Expand_Pragma_Import_Or_Interface): if the
pragma comes from an aspect specification, the entity is the
first argument.
* sem_prag.adb (Analyze_Pragma, cases Pragma_Export and
Pragma_Import): if the pragma comes from an aspect specification,
the entity is the first argument, and the second has the value
True by default.
* sem_ch13.adb (Analyze_Aspect_Specifications): generate pragam
for aspect Convention. Add placeholders for Link_Name and
External_Name.
Index: exp_prag.adb
===================================================================
--- exp_prag.adb (revision 187501)
+++ exp_prag.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -527,10 +527,18 @@
-- seen (i.e. this elaboration cannot be deferred to the freeze point).
procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
- Def_Id : constant Entity_Id := Entity (Arg2 (N));
+ Def_Id : Entity_Id;
Init_Call : Node_Id;
begin
+ -- If the pragma comes from an aspect, the entity is its first argument.
+
+ if Present (Corresponding_Aspect (N)) then
+ Def_Id := Entity (Arg1 (N));
+ else
+ Def_Id := Entity (Arg2 (N));
+ end if;
+
if Ekind (Def_Id) = E_Variable then
-- Find generated initialization call for object, if any
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 187501)
+++ sem_prag.adb (working copy)
@@ -8633,7 +8633,30 @@
Name_Entity,
Name_External_Name,
Name_Link_Name));
- Check_At_Least_N_Arguments (2);
+
+ if Present (Corresponding_Aspect (N)) then
+
+ -- If the pragma comes from an Aspect, there is a single entity
+ -- parameter and an optional booean value with default true.
+ -- The convention must be provided by a separate aspect.
+
+ Check_At_Least_N_Arguments (1);
+ Check_At_Most_N_Arguments (2);
+ Def_Id := Entity (Arg1);
+
+ if No (Arg2) then
+
+ -- If the aspect has a default True value, set corresponding
+ -- flag on the entity.
+
+ Set_Is_Exported (Def_Id);
+ end if;
+ return;
+
+ else
+ Check_At_Least_N_Arguments (2);
+ end if;
+
Check_At_Most_N_Arguments (4);
Process_Convention (C, Def_Id);
@@ -9566,10 +9589,31 @@
Name_Entity,
Name_External_Name,
Name_Link_Name));
- Check_At_Least_N_Arguments (2);
- Check_At_Most_N_Arguments (4);
- Process_Import_Or_Interface;
+ if Present (Corresponding_Aspect (N)) then
+
+ -- If the pragma comes from an Aspect, there is a single entity
+ -- parameter and an optional booean value with default true.
+ -- The convention must be provided by a separate aspect.
+
+ Check_At_Least_N_Arguments (1);
+ Check_At_Most_N_Arguments (2);
+
+ if No (Arg2) then
+
+ -- If the aspect has a default True value, set corresponding
+ -- flag on the entity.
+
+ Set_Is_Imported (Entity (Arg1));
+ end if;
+ return;
+
+ else
+ Check_At_Least_N_Arguments (2);
+ Check_At_Most_N_Arguments (4);
+ Process_Import_Or_Interface;
+ end if;
+
----------------------
-- Import_Exception --
----------------------
Index: aspects.adb
===================================================================
--- aspects.adb (revision 187505)
+++ aspects.adb (working copy)
@@ -252,6 +252,7 @@
Aspect_Component_Size => Aspect_Component_Size,
Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Contract_Case => Aspect_Contract_Case,
+ Aspect_Convention => Aspect_Convention,
Aspect_CPU => Aspect_CPU,
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
Aspect_Default_Iterator => Aspect_Default_Iterator,
@@ -262,9 +263,12 @@
Aspect_Dispatching_Domain => Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate => Aspect_Predicate,
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
+ Aspect_Export => Aspect_Export,
+ Aspect_External_Name => Aspect_External_Name,
Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
+ Aspect_Import => Aspect_Import,
Aspect_Independent => Aspect_Independent,
Aspect_Independent_Components => Aspect_Independent_Components,
Aspect_Inline => Aspect_Inline,
@@ -274,6 +278,7 @@
Aspect_Interrupt_Priority => Aspect_Interrupt_Priority,
Aspect_Invariant => Aspect_Invariant,
Aspect_Iterator_Element => Aspect_Iterator_Element,
+ Aspect_Link_Name => Aspect_Link_Name,
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
Aspect_No_Return => Aspect_No_Return,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 187505)
+++ aspects.ads (working copy)
@@ -51,6 +51,7 @@
Aspect_Component_Size,
Aspect_Constant_Indexing,
Aspect_Contract_Case, -- GNAT
+ Aspect_Convention,
Aspect_CPU,
Aspect_Default_Component_Value,
Aspect_Default_Iterator,
@@ -59,12 +60,14 @@
Aspect_Dimension_System, -- GNAT
Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate,
+ Aspect_External_Name,
Aspect_External_Tag,
Aspect_Implicit_Dereference,
Aspect_Input,
Aspect_Interrupt_Priority,
Aspect_Invariant,
Aspect_Iterator_Element,
+ Aspect_Link_Name,
Aspect_Machine_Radix,
Aspect_Object_Size, -- GNAT
Aspect_Output,
@@ -121,9 +124,11 @@
Aspect_Atomic,
Aspect_Atomic_Components,
Aspect_Discard_Names,
+ Aspect_Export,
Aspect_Favor_Top_Level, -- GNAT
Aspect_Independent,
Aspect_Independent_Components,
+ Aspect_Import,
Aspect_Inline,
Aspect_Inline_Always, -- GNAT
Aspect_Interrupt_Handler,
@@ -269,6 +274,7 @@
Aspect_Component_Size => Expression,
Aspect_Constant_Indexing => Name,
Aspect_Contract_Case => Expression,
+ Aspect_Convention => Name,
Aspect_CPU => Expression,
Aspect_Default_Component_Value => Expression,
Aspect_Default_Iterator => Name,
@@ -277,12 +283,14 @@
Aspect_Dimension_System => Expression,
Aspect_Dispatching_Domain => Expression,
Aspect_Dynamic_Predicate => Expression,
+ Aspect_External_Name => Expression,
Aspect_External_Tag => Expression,
Aspect_Implicit_Dereference => Name,
Aspect_Input => Name,
Aspect_Interrupt_Priority => Expression,
Aspect_Invariant => Expression,
Aspect_Iterator_Element => Name,
+ Aspect_Link_Name => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Object_Size => Expression,
Aspect_Output => Name,
@@ -336,6 +344,7 @@
Aspect_Component_Size => Name_Component_Size,
Aspect_Constant_Indexing => Name_Constant_Indexing,
Aspect_Contract_Case => Name_Contract_Case,
+ Aspect_Convention => Name_Convention,
Aspect_CPU => Name_CPU,
Aspect_Default_Iterator => Name_Default_Iterator,
Aspect_Default_Value => Name_Default_Value,
@@ -346,9 +355,12 @@
Aspect_Dispatching_Domain => Name_Dispatching_Domain,
Aspect_Dynamic_Predicate => Name_Dynamic_Predicate,
Aspect_Elaborate_Body => Name_Elaborate_Body,
+ Aspect_External_Name => Name_External_Name,
Aspect_External_Tag => Name_External_Tag,
+ Aspect_Export => Name_Export,
Aspect_Favor_Top_Level => Name_Favor_Top_Level,
Aspect_Implicit_Dereference => Name_Implicit_Dereference,
+ Aspect_Import => Name_Import,
Aspect_Independent => Name_Independent,
Aspect_Independent_Components => Name_Independent_Components,
Aspect_Inline => Name_Inline,
@@ -358,6 +370,7 @@
Aspect_Interrupt_Priority => Name_Interrupt_Priority,
Aspect_Invariant => Name_Invariant,
Aspect_Iterator_Element => Name_Iterator_Element,
+ Aspect_Link_Name => Name_Link_Name,
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_No_Return => Name_No_Return,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 187506)
+++ sem_ch13.adb (working copy)
@@ -1168,6 +1168,14 @@
-- the second argument is a local name referring to the entity,
-- and the first argument is the aspect definition expression.
+ when Aspect_Convention =>
+ Aitem :=
+ Make_Pragma (Loc,
+ Pragma_Argument_Associations =>
+ New_List (Relocate_Node (Expr), Ent),
+ Pragma_Identifier =>
+ Make_Identifier (Sloc (Id), Chars (Id)));
+
when Aspect_Warnings =>
-- Construct the pragma
@@ -1562,6 +1570,13 @@
Analyze_Aspect_Dimension_System (N, Id, Expr);
goto Continue;
+ -- Placeholders for new aspects without corresponding pragmas
+
+ when Aspect_External_Name =>
+ null;
+
+ when Aspect_Link_Name =>
+ null;
end case;
-- If a delay is required, we delay the freeze (not much point in
@@ -6199,6 +6214,9 @@
when Aspect_Attach_Handler =>
T := RTE (RE_Interrupt_ID);
+ when Aspect_Convention =>
+ null;
+
-- Default_Value is resolved with the type entity in question
when Aspect_Default_Value =>
@@ -6226,6 +6244,12 @@
when Aspect_External_Tag =>
T := Standard_String;
+ when Aspect_External_Name =>
+ T := Standard_String;
+
+ when Aspect_Link_Name =>
+ T := Standard_String;
+
when Aspect_Priority | Aspect_Interrupt_Priority =>
T := Standard_Integer;
