2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
+ * sem_prag.adb (Analyze_Dependency_Clause): Add new local variable
+ Non_Null_Output_Seen. Update the call to Analyze_Input_Output.
+ (Analyze_Input_Item): Streamline the detection mechanism of null and
+ non-null items.
+ (Analyze_Input_List): Add new local variable
+ Non_Null_Input_Seen. Update all calls to Analyze_Input_Output.
+ (Analyze_Input_Output): Add new formal parameter Non_Null_Seen
+ and update the related comment on usage. Update the
+ recursive call to itself. Attribute 'Result is now treated
+ as a non-null item. Detect mixes of null and non-null items.
+ (Analyze_Initialization_Item): Streamline the detection mechanism
+ of null and non-null items.
+
+2013-10-14 Vincent Celier <celier@adacore.com>
+
+ * projects.texi: Add documentation for the new project level
+ attribute Library_Rpath_Options.
+
+2013-10-14 Tristan Gingold <gingold@adacore.com>
+
+ * a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure.
+ (Set_Foreign_Occurrence): New procedure, extracted from
+ Setup_Current_Excep.
+ * exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice
+ parameter in case of zcx.
+ * sem_ch11.adb (Analyze_Exception_Handlers): Need debug info
+ for the choice parameter.
+ * raise-gcc.c: Add comments.
+
+2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
+
* aspects.adb: Add an entry in table Canonical_Aspect for
Initial_Condition.
* aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument,
(GCC_Exception : not null GCC_Exception_Access);
pragma No_Return (Reraise_GCC_Exception);
pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
- -- Called to implement raise without exception, ie reraise. Called
+ -- Called to implement raise without exception, ie reraise. Called
-- directly from gigi.
function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access) return EOA;
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
- -- Write Get_Current_Excep.all from GCC_Exception
+ -- Write Get_Current_Excep.all from GCC_Exception. Called by the
+ -- personnality routine.
procedure Unhandled_Except_Handler
(GCC_Exception : not null GCC_Exception_Access);
UW_Argument : System.Address);
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
+ procedure Set_Exception_Parameter
+ (Excep : EOA;
+ GCC_Exception : not null GCC_Exception_Access);
+ pragma Export (C, Set_Exception_Parameter,
+ "__gnat_set_exception_parameter");
+ -- Called inserted by gigi to initialize the exception parameter
+
+ procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
+ -- Utility routine to initialize occurrence Excep for a foreign exception
+ -- whose machine occurrence is Mo.
+
-- Hooks called when entering/leaving an exception handler for a given
-- occurrence, aimed at handling the stack of active occurrences. The
-- calls are generated by gigi in tree_transform/N_Exception_Handler.
Free (Copy);
end GNAT_GCC_Exception_Cleanup;
+ ----------------------------
+ -- Set_Foreign_Occurrence --
+ ----------------------------
+
+ procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
+ begin
+ Excep.Id := Foreign_Exception'Access;
+ Excep.Machine_Occurrence := Mo;
+ Excep.Msg_Length := 0;
+ Excep.Exception_Raised := True;
+ Excep.Pid := Local_Partition_ID;
+ Excep.Num_Tracebacks := 0;
+ end Set_Foreign_Occurrence;
+
-------------------------
-- Setup_Current_Excep --
-------------------------
-- A default one
- Excep.Id := Foreign_Exception'Access;
- Excep.Machine_Occurrence := GCC_Exception.all'Address;
- Excep.Msg_Length := 0;
- Excep.Exception_Raised := True;
- Excep.Pid := Local_Partition_ID;
- Excep.Num_Tracebacks := 0;
+ Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
return Excep;
end if;
Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
end Propagate_Exception;
+ -----------------------------
+ -- Set_Exception_Parameter --
+ -----------------------------
+
+ procedure Set_Exception_Parameter
+ (Excep : EOA;
+ GCC_Exception : not null GCC_Exception_Access) is
+ begin
+ -- Setup the exception occurrence
+
+ if GCC_Exception.Class = GNAT_Exception_Class then
+
+ -- From the GCC exception
+
+ declare
+ GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+ To_GNAT_GCC_Exception (GCC_Exception);
+ begin
+ Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
+ end;
+ else
+
+ -- A default one
+
+ Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
+ end if;
+ end Set_Exception_Parameter;
+
------------------------------
-- Unhandled_Except_Handler --
------------------------------
-- ...
-- end;
- if Present (Choice_Parameter (Handler)) then
+ -- This expansion is not performed when using GCC ZCX. Gigi
+ -- will insert a call to intialize the choice parameter.
+
+ if Present (Choice_Parameter (Handler))
+ and then Exception_Mechanism /= Back_End_Exceptions
+ then
declare
Cparm : constant Entity_Id := Choice_Parameter (Handler);
Cloc : constant Source_Ptr := Sloc (Cparm);
Value is a list of options that are to be used when linking a shared library.
+@item @b{Library_Rpath_Options}: list, indexed, case-insensitive index
+
+Index is a language name. Value is a list of options for an invocation of the
+compiler of the language. This invocation is done for a shared library project
+with sources of the language. The output of the invocation is the path name
+of a shared library file. The directory name is to be put in the run path
+option switch when linking the shared library for the project.
+
@item @b{Library_Src_Dir}: single
Value is the name of the directory where copies of the sources of the
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
- /* Write current exception, so that it can be retrieved from Ada. */
+ /* Write current exception, so that it can be retrieved from Ada. It was
+ already done during phase 1 (just above), but in between, one or several
+ exceptions may have been raised (in cleanup handlers). */
__gnat_setup_current_excep (uw_exception);
return _URC_INSTALL_CONTEXT;
if Comes_From_Source (Choice) then
Check_Restriction (No_Exception_Propagation, Choice);
+ Set_Debug_Info_Needed (Choice);
end if;
if No (H_Scope) then
-- Verify the legality of a single input list
procedure Analyze_Input_Output
- (Item : Node_Id;
- Is_Input : Boolean;
- Self_Ref : Boolean;
- Top_Level : Boolean;
- Seen : in out Elist_Id;
- Null_Seen : in out Boolean);
+ (Item : Node_Id;
+ Is_Input : Boolean;
+ Self_Ref : Boolean;
+ Top_Level : Boolean;
+ Seen : in out Elist_Id;
+ Null_Seen : in out Boolean;
+ Non_Null_Seen : in out Boolean);
-- Verify the legality of a single input or output item. Flag
-- Is_Input should be set whenever Item is an input, False when it
-- denotes an output. Flag Self_Ref should be set when the item is an
-- be set whenever Item appears immediately within an input or output
-- list. Seen is a collection of all abstract states, variables and
-- formals processed so far. Flag Null_Seen denotes whether a null
- -- input or output has been encountered.
+ -- input or output has been encountered. Flag Non_Null_Seen denotes
+ -- whether a non-null input or output has been encountered.
------------------------
-- Analyze_Input_List --
-- A list containing the entities of all inputs that appear in the
-- current input list.
- Null_Input_Seen : Boolean := False;
- -- A flag used to track the legality of a null input
+ Non_Null_Input_Seen : Boolean := False;
+ Null_Input_Seen : Boolean := False;
+ -- Flags used to check the legality of an input list
Input : Node_Id;
Input := First (Expressions (Inputs));
while Present (Input) loop
Analyze_Input_Output
- (Item => Input,
- Is_Input => True,
- Self_Ref => False,
- Top_Level => False,
- Seen => Inputs_Seen,
- Null_Seen => Null_Input_Seen);
+ (Item => Input,
+ Is_Input => True,
+ Self_Ref => False,
+ Top_Level => False,
+ Seen => Inputs_Seen,
+ Null_Seen => Null_Input_Seen,
+ Non_Null_Seen => Non_Null_Input_Seen);
Next (Input);
end loop;
else
Analyze_Input_Output
- (Item => Inputs,
- Is_Input => True,
- Self_Ref => False,
- Top_Level => False,
- Seen => Inputs_Seen,
- Null_Seen => Null_Input_Seen);
+ (Item => Inputs,
+ Is_Input => True,
+ Self_Ref => False,
+ Top_Level => False,
+ Seen => Inputs_Seen,
+ Null_Seen => Null_Input_Seen,
+ Non_Null_Seen => Non_Null_Input_Seen);
end if;
-- Detect an illegal dependency clause of the form
--------------------------
procedure Analyze_Input_Output
- (Item : Node_Id;
- Is_Input : Boolean;
- Self_Ref : Boolean;
- Top_Level : Boolean;
- Seen : in out Elist_Id;
- Null_Seen : in out Boolean)
+ (Item : Node_Id;
+ Is_Input : Boolean;
+ Self_Ref : Boolean;
+ Top_Level : Boolean;
+ Seen : in out Elist_Id;
+ Null_Seen : in out Boolean;
+ Non_Null_Seen : in out Boolean)
is
Is_Output : constant Boolean := not Is_Input;
Grouped : Node_Id;
Grouped := First (Expressions (Item));
while Present (Grouped) loop
Analyze_Input_Output
- (Item => Grouped,
- Is_Input => Is_Input,
- Self_Ref => Self_Ref,
- Top_Level => False,
- Seen => Seen,
- Null_Seen => Null_Seen);
+ (Item => Grouped,
+ Is_Input => Is_Input,
+ Self_Ref => Self_Ref,
+ Top_Level => False,
+ Seen => Seen,
+ Null_Seen => Null_Seen,
+ Non_Null_Seen => Non_Null_Seen);
Next (Grouped);
end loop;
-- Process Function'Result in the context of a dependency clause
elsif Is_Attribute_Result (Item) then
+ Non_Null_Seen := True;
-- It is sufficent to analyze the prefix of 'Result in order to
-- establish legality of the attribute.
elsif Is_Input then
Error_Msg_N ("function result cannot act as input", Item);
+ elsif Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null dependency items", Item);
+
else
Result_Seen := True;
end if;
if Null_Seen then
Error_Msg_N
("multiple null dependency relations not allowed", Item);
+
+ elsif Non_Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null dependency items", Item);
+
else
Null_Seen := True;
- if Is_Output and then not Is_Last then
- Error_Msg_N
- ("null output list must be the last clause in a "
- & "dependency relation", Item);
+ if Is_Output then
+ if not Is_Last then
+ Error_Msg_N
+ ("null output list must be the last clause in a "
+ & "dependency relation", Item);
+
+ -- Catch a useless dependence of the form:
+ -- null =>+ ...
+
+ elsif Self_Ref then
+ Error_Msg_N
+ ("useless dependence, null depends on itself", Item);
+ end if;
end if;
end if;
-- Default case
else
+ Non_Null_Seen := True;
+
+ if Null_Seen then
+ Error_Msg_N ("cannot mix null and non-null items", Item);
+ end if;
+
Analyze (Item);
-- Find the entity of the item. If this is a renaming, climb
Output : Node_Id;
Self_Ref : Boolean;
+ Non_Null_Output_Seen : Boolean := False;
+ -- Flag used to check the legality of an output list
+
-- Start of processing for Analyze_Dependency_Clause
begin
Output := First (Choices (Clause));
while Present (Output) loop
Analyze_Input_Output
- (Item => Output,
- Is_Input => False,
- Self_Ref => Self_Ref,
- Top_Level => True,
- Seen => All_Outputs_Seen,
- Null_Seen => Null_Output_Seen);
+ (Item => Output,
+ Is_Input => False,
+ Self_Ref => Self_Ref,
+ Top_Level => True,
+ Seen => All_Outputs_Seen,
+ Null_Seen => Null_Output_Seen,
+ Non_Null_Seen => Non_Null_Output_Seen);
Next (Output);
end loop;
Item_Id : Entity_Id;
begin
- -- A package with null initialization list is not allowed to have
- -- additional initializations.
-
- if Null_Seen then
- Error_Msg_NE ("package & has null initialization", Item, Pack_Id);
-
-- Null initialization list
- elsif Nkind (Item) = N_Null then
-
- -- Catch a case where a null initialization item appears in a list
- -- of non-null items.
+ if Nkind (Item) = N_Null then
+ if Null_Seen then
+ Error_Msg_N ("multiple null initializations not allowed", Item);
- if Non_Null_Seen then
- Error_Msg_NE
- ("package & has non-null initialization", Item, Pack_Id);
+ elsif Non_Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null initialization items", Item);
else
Null_Seen := True;
end if;
else
Non_Null_Seen := True;
+ if Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null initialization items", Item);
+ end if;
+
Analyze (Item);
if Is_Entity_Name (Item) then
Input_Id : Entity_Id;
begin
- -- An initialization item with null inputs is not allowed to have
- -- assitional inputs.
-
- if Null_Seen then
- Error_Msg_N ("item has null input list", Item);
-
-- Null input list
- elsif Nkind (Input) = N_Null then
-
- -- Catch a case where a null input appears in a list of non-
- -- null inpits.
+ if Nkind (Input) = N_Null then
+ if Null_Seen then
+ Error_Msg_N
+ ("multiple null initializations not allowed", Item);
- if Non_Null_Seen then
- Error_Msg_N ("item has non-null input list", Item);
+ elsif Non_Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null initialization item", Item);
else
Null_Seen := True;
end if;
else
Non_Null_Seen := True;
+ if Null_Seen then
+ Error_Msg_N
+ ("cannot mix null and non-null initialization item", Item);
+ end if;
+
Analyze (Input);
if Is_Entity_Name (Input) then
elsif Nkind (State) = N_Null then
Name := New_Internal_Name ('S');
- Is_Null := True;
+ Is_Null := True;
Null_Seen := True;
-- Catch a case where a null state appears in a list of
Dep_Id := Entity_Of (Dep_Input);
-- Inspect all inputs of the refinement clause and attempt
- -- to match against the inputs of the dependance clause.
+ -- to match against the inputs of the dependence clause.
Ref_Input := First (Ref_Inputs);
while Present (Ref_Input) loop
begin
-- The analysis of pragma Depends should produce normalized clauses
-- with exactly one output. This is important because output items
- -- are unique in the whole dependance relation and can be used as
+ -- are unique in the whole dependence relation and can be used as
-- keys.
pragma Assert (No (Next (Dep_Output)));
projects / platform / upstream / gcc.git / commitdiff