[Ada] Interfacing aspects in Ada 2012

Arnaud Charlet charlet@adacore.com
Tue May 15 10:52:00 GMT 2012


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  <schonberg@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.

-------------- next part --------------
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;
 


More information about the Gcc-patches mailing list