+2012-05-15 Tristan Gingold <gingold@adacore.com>
+
+ * a-exextr.adb: Add comment.
+
+2012-05-15 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb: Minor reformatting (remove long dead code).
+
+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.
+
2012-05-15 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb (Expand_N_Asynchronous_Select): Extract the statements
-----------------------------------
procedure Unhandled_Exception_Terminate is
-
- -- Comments needed on why we do things this way ??? (see RH)
-
Excep : Exception_Occurrence;
-- This occurrence will be used to display a message after finalization.
-- It is necessary to save a copy here, or else the designated value
-- could be overwritten if an exception is raised during finalization
- -- (even if that exception is caught).
+ -- (even if that exception is caught). The occurrence is saved on the
+ -- stack to avoid dynamic allocation (if this exception is due to lack
+ -- of space in the heap, we therefore avoid a second failure). We assume
+ -- that there is enough room on the stack however.
begin
Save_Occurrence (Excep, Get_Current_Excep.all.all);
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,
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,
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,
Aspect_Component_Size,
Aspect_Constant_Indexing,
Aspect_Contract_Case, -- GNAT
+ Aspect_Convention,
Aspect_CPU,
Aspect_Default_Component_Value,
Aspect_Default_Iterator,
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,
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,
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,
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,
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,
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,
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,
-- --
-- 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- --
-- 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
-- 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
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
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 =>
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;
else
Validate_Controlled_Object (Id);
end if;
-
- -- Generate a warning when an initialization causes an obvious ABE
- -- violation. If the init expression is a simple aggregate there
- -- shouldn't be any initialize/adjust call generated. This will be
- -- true as soon as aggregates are built in place when possible.
-
- -- ??? at the moment we do not generate warnings for temporaries
- -- created for those aggregates although Program_Error might be
- -- generated if compiled with -gnato.
-
- if Is_Controlled (Etype (Id))
- and then Comes_From_Source (Id)
- then
- declare
- BT : constant Entity_Id := Base_Type (Etype (Id));
-
- Implicit_Call : Entity_Id;
- pragma Warnings (Off, Implicit_Call);
- -- ??? what is this for (never referenced!)
-
- function Is_Aggr (N : Node_Id) return Boolean;
- -- Check that N is an aggregate
-
- -------------
- -- Is_Aggr --
- -------------
-
- function Is_Aggr (N : Node_Id) return Boolean is
- begin
- case Nkind (Original_Node (N)) is
- when N_Aggregate | N_Extension_Aggregate =>
- return True;
-
- when N_Qualified_Expression |
- N_Type_Conversion |
- N_Unchecked_Type_Conversion =>
- return Is_Aggr (Expression (Original_Node (N)));
-
- when others =>
- return False;
- end case;
- end Is_Aggr;
-
- begin
- -- If no underlying type, we already are in an error situation.
- -- Do not try to add a warning since we do not have access to
- -- prim-op list.
-
- if No (Underlying_Type (BT)) then
- Implicit_Call := Empty;
-
- -- A generic type does not have usable primitive operators.
- -- Initialization calls are built for instances.
-
- elsif Is_Generic_Type (BT) then
- Implicit_Call := Empty;
-
- -- If the init expression is not an aggregate, an adjust call
- -- will be generated
-
- elsif Present (E) and then not Is_Aggr (E) then
- Implicit_Call := Find_Prim_Op (BT, Name_Adjust);
-
- -- If no init expression and we are not in the deferred
- -- constant case, an Initialize call will be generated
-
- elsif No (E) and then not Constant_Present (N) then
- Implicit_Call := Find_Prim_Op (BT, Name_Initialize);
-
- else
- Implicit_Call := Empty;
- end if;
- end;
- end if;
end if;
if Has_Task (Etype (Id)) then
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);
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 --
projects / gcc.git / commitdiff