Commit e74d643a by Arnaud Charlet

[multiple changes]

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.

From-SVN: r203552
parent 9b2451e5
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com> 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 * aspects.adb: Add an entry in table Canonical_Aspect for
Initial_Condition. Initial_Condition.
* aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument, * aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument,
......
...@@ -205,7 +205,8 @@ package body Exception_Propagation is ...@@ -205,7 +205,8 @@ package body Exception_Propagation is
function Setup_Current_Excep function Setup_Current_Excep
(GCC_Exception : not null GCC_Exception_Access) return EOA; (GCC_Exception : not null GCC_Exception_Access) return EOA;
pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); 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 procedure Unhandled_Except_Handler
(GCC_Exception : not null GCC_Exception_Access); (GCC_Exception : not null GCC_Exception_Access);
...@@ -243,6 +244,17 @@ package body Exception_Propagation is ...@@ -243,6 +244,17 @@ package body Exception_Propagation is
UW_Argument : System.Address); UW_Argument : System.Address);
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); 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 -- Hooks called when entering/leaving an exception handler for a given
-- occurrence, aimed at handling the stack of active occurrences. The -- occurrence, aimed at handling the stack of active occurrences. The
-- calls are generated by gigi in tree_transform/N_Exception_Handler. -- calls are generated by gigi in tree_transform/N_Exception_Handler.
...@@ -338,6 +350,20 @@ package body Exception_Propagation is ...@@ -338,6 +350,20 @@ package body Exception_Propagation is
Free (Copy); Free (Copy);
end GNAT_GCC_Exception_Cleanup; 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 -- -- Setup_Current_Excep --
------------------------- -------------------------
...@@ -366,12 +392,7 @@ package body Exception_Propagation is ...@@ -366,12 +392,7 @@ package body Exception_Propagation is
-- A default one -- A default one
Excep.Id := Foreign_Exception'Access; Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
Excep.Machine_Occurrence := GCC_Exception.all'Address;
Excep.Msg_Length := 0;
Excep.Exception_Raised := True;
Excep.Pid := Local_Partition_ID;
Excep.Num_Tracebacks := 0;
return Excep; return Excep;
end if; end if;
...@@ -465,6 +486,34 @@ package body Exception_Propagation is ...@@ -465,6 +486,34 @@ package body Exception_Propagation is
Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence)); Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
end Propagate_Exception; 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 -- -- Unhandled_Except_Handler --
------------------------------ ------------------------------
......
...@@ -1025,7 +1025,12 @@ package body Exp_Ch11 is ...@@ -1025,7 +1025,12 @@ package body Exp_Ch11 is
-- ... -- ...
-- end; -- 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 declare
Cparm : constant Entity_Id := Choice_Parameter (Handler); Cparm : constant Entity_Id := Choice_Parameter (Handler);
Cloc : constant Source_Ptr := Sloc (Cparm); Cloc : constant Source_Ptr := Sloc (Cparm);
......
...@@ -3962,6 +3962,14 @@ the command line when linking a shared library. ...@@ -3962,6 +3962,14 @@ the command line when linking a shared library.
Value is a list of options that are to be used when linking a shared library. 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 @item @b{Library_Src_Dir}: single
Value is the name of the directory where copies of the sources of the Value is the name of the directory where copies of the sources of the
......
...@@ -1217,7 +1217,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, ...@@ -1217,7 +1217,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
setup_to_install setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter); (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); __gnat_setup_current_excep (uw_exception);
return _URC_INSTALL_CONTEXT; return _URC_INSTALL_CONTEXT;
......
...@@ -199,6 +199,7 @@ package body Sem_Ch11 is ...@@ -199,6 +199,7 @@ package body Sem_Ch11 is
if Comes_From_Source (Choice) then if Comes_From_Source (Choice) then
Check_Restriction (No_Exception_Propagation, Choice); Check_Restriction (No_Exception_Propagation, Choice);
Set_Debug_Info_Needed (Choice);
end if; end if;
if No (H_Scope) then if No (H_Scope) then
......
...@@ -560,7 +560,8 @@ package body Sem_Prag is ...@@ -560,7 +560,8 @@ package body Sem_Prag is
Self_Ref : Boolean; Self_Ref : Boolean;
Top_Level : Boolean; Top_Level : Boolean;
Seen : in out Elist_Id; Seen : in out Elist_Id;
Null_Seen : in out Boolean); Null_Seen : in out Boolean;
Non_Null_Seen : in out Boolean);
-- Verify the legality of a single input or output item. Flag -- Verify the legality of a single input or output item. Flag
-- Is_Input should be set whenever Item is an input, False when it -- 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 -- denotes an output. Flag Self_Ref should be set when the item is an
...@@ -568,7 +569,8 @@ package body Sem_Prag is ...@@ -568,7 +569,8 @@ package body Sem_Prag is
-- be set whenever Item appears immediately within an input or output -- be set whenever Item appears immediately within an input or output
-- list. Seen is a collection of all abstract states, variables and -- list. Seen is a collection of all abstract states, variables and
-- formals processed so far. Flag Null_Seen denotes whether a null -- 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 -- -- Analyze_Input_List --
...@@ -579,8 +581,9 @@ package body Sem_Prag is ...@@ -579,8 +581,9 @@ package body Sem_Prag is
-- A list containing the entities of all inputs that appear in the -- A list containing the entities of all inputs that appear in the
-- current input list. -- current input list.
Non_Null_Input_Seen : Boolean := False;
Null_Input_Seen : Boolean := False; Null_Input_Seen : Boolean := False;
-- A flag used to track the legality of a null input -- Flags used to check the legality of an input list
Input : Node_Id; Input : Node_Id;
...@@ -601,7 +604,8 @@ package body Sem_Prag is ...@@ -601,7 +604,8 @@ package body Sem_Prag is
Self_Ref => False, Self_Ref => False,
Top_Level => False, Top_Level => False,
Seen => Inputs_Seen, Seen => Inputs_Seen,
Null_Seen => Null_Input_Seen); Null_Seen => Null_Input_Seen,
Non_Null_Seen => Non_Null_Input_Seen);
Next (Input); Next (Input);
end loop; end loop;
...@@ -619,7 +623,8 @@ package body Sem_Prag is ...@@ -619,7 +623,8 @@ package body Sem_Prag is
Self_Ref => False, Self_Ref => False,
Top_Level => False, Top_Level => False,
Seen => Inputs_Seen, Seen => Inputs_Seen,
Null_Seen => Null_Input_Seen); Null_Seen => Null_Input_Seen,
Non_Null_Seen => Non_Null_Input_Seen);
end if; end if;
-- Detect an illegal dependency clause of the form -- Detect an illegal dependency clause of the form
...@@ -643,7 +648,8 @@ package body Sem_Prag is ...@@ -643,7 +648,8 @@ package body Sem_Prag is
Self_Ref : Boolean; Self_Ref : Boolean;
Top_Level : Boolean; Top_Level : Boolean;
Seen : in out Elist_Id; Seen : in out Elist_Id;
Null_Seen : in out Boolean) Null_Seen : in out Boolean;
Non_Null_Seen : in out Boolean)
is is
Is_Output : constant Boolean := not Is_Input; Is_Output : constant Boolean := not Is_Input;
Grouped : Node_Id; Grouped : Node_Id;
...@@ -671,7 +677,8 @@ package body Sem_Prag is ...@@ -671,7 +677,8 @@ package body Sem_Prag is
Self_Ref => Self_Ref, Self_Ref => Self_Ref,
Top_Level => False, Top_Level => False,
Seen => Seen, Seen => Seen,
Null_Seen => Null_Seen); Null_Seen => Null_Seen,
Non_Null_Seen => Non_Null_Seen);
Next (Grouped); Next (Grouped);
end loop; end loop;
...@@ -683,6 +690,7 @@ package body Sem_Prag is ...@@ -683,6 +690,7 @@ package body Sem_Prag is
-- Process Function'Result in the context of a dependency clause -- Process Function'Result in the context of a dependency clause
elsif Is_Attribute_Result (Item) then elsif Is_Attribute_Result (Item) then
Non_Null_Seen := True;
-- It is sufficent to analyze the prefix of 'Result in order to -- It is sufficent to analyze the prefix of 'Result in order to
-- establish legality of the attribute. -- establish legality of the attribute.
...@@ -707,6 +715,10 @@ package body Sem_Prag is ...@@ -707,6 +715,10 @@ package body Sem_Prag is
elsif Is_Input then elsif Is_Input then
Error_Msg_N ("function result cannot act as input", Item); 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 else
Result_Seen := True; Result_Seen := True;
end if; end if;
...@@ -719,19 +731,39 @@ package body Sem_Prag is ...@@ -719,19 +731,39 @@ package body Sem_Prag is
if Null_Seen then if Null_Seen then
Error_Msg_N Error_Msg_N
("multiple null dependency relations not allowed", Item); ("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 else
Null_Seen := True; Null_Seen := True;
if Is_Output and then not Is_Last then if Is_Output then
if not Is_Last then
Error_Msg_N Error_Msg_N
("null output list must be the last clause in a " ("null output list must be the last clause in a "
& "dependency relation", Item); & "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;
end if; end if;
-- Default case -- Default case
else else
Non_Null_Seen := True;
if Null_Seen then
Error_Msg_N ("cannot mix null and non-null items", Item);
end if;
Analyze (Item); Analyze (Item);
-- Find the entity of the item. If this is a renaming, climb -- Find the entity of the item. If this is a renaming, climb
...@@ -845,6 +877,9 @@ package body Sem_Prag is ...@@ -845,6 +877,9 @@ package body Sem_Prag is
Output : Node_Id; Output : Node_Id;
Self_Ref : Boolean; 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 -- Start of processing for Analyze_Dependency_Clause
begin begin
...@@ -869,7 +904,8 @@ package body Sem_Prag is ...@@ -869,7 +904,8 @@ package body Sem_Prag is
Self_Ref => Self_Ref, Self_Ref => Self_Ref,
Top_Level => True, Top_Level => True,
Seen => All_Outputs_Seen, Seen => All_Outputs_Seen,
Null_Seen => Null_Output_Seen); Null_Seen => Null_Output_Seen,
Non_Null_Seen => Non_Null_Output_Seen);
Next (Output); Next (Output);
end loop; end loop;
...@@ -2192,22 +2228,15 @@ package body Sem_Prag is ...@@ -2192,22 +2228,15 @@ package body Sem_Prag is
Item_Id : Entity_Id; Item_Id : Entity_Id;
begin 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 -- Null initialization list
elsif Nkind (Item) = N_Null then if Nkind (Item) = N_Null then
if Null_Seen then
-- Catch a case where a null initialization item appears in a list Error_Msg_N ("multiple null initializations not allowed", Item);
-- of non-null items.
if Non_Null_Seen then elsif Non_Null_Seen then
Error_Msg_NE Error_Msg_N
("package & has non-null initialization", Item, Pack_Id); ("cannot mix null and non-null initialization items", Item);
else else
Null_Seen := True; Null_Seen := True;
end if; end if;
...@@ -2217,6 +2246,11 @@ package body Sem_Prag is ...@@ -2217,6 +2246,11 @@ package body Sem_Prag is
else else
Non_Null_Seen := True; Non_Null_Seen := True;
if Null_Seen then
Error_Msg_N
("cannot mix null and non-null initialization items", Item);
end if;
Analyze (Item); Analyze (Item);
if Is_Entity_Name (Item) then if Is_Entity_Name (Item) then
...@@ -2287,21 +2321,16 @@ package body Sem_Prag is ...@@ -2287,21 +2321,16 @@ package body Sem_Prag is
Input_Id : Entity_Id; Input_Id : Entity_Id;
begin 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 -- Null input list
elsif Nkind (Input) = N_Null then if Nkind (Input) = N_Null then
if Null_Seen then
-- Catch a case where a null input appears in a list of non- Error_Msg_N
-- null inpits. ("multiple null initializations not allowed", Item);
if Non_Null_Seen then elsif Non_Null_Seen then
Error_Msg_N ("item has non-null input list", Item); Error_Msg_N
("cannot mix null and non-null initialization item", Item);
else else
Null_Seen := True; Null_Seen := True;
end if; end if;
...@@ -2311,6 +2340,11 @@ package body Sem_Prag is ...@@ -2311,6 +2340,11 @@ package body Sem_Prag is
else else
Non_Null_Seen := True; Non_Null_Seen := True;
if Null_Seen then
Error_Msg_N
("cannot mix null and non-null initialization item", Item);
end if;
Analyze (Input); Analyze (Input);
if Is_Entity_Name (Input) then if Is_Entity_Name (Input) then
...@@ -19946,7 +19980,7 @@ package body Sem_Prag is ...@@ -19946,7 +19980,7 @@ package body Sem_Prag is
Dep_Id := Entity_Of (Dep_Input); Dep_Id := Entity_Of (Dep_Input);
-- Inspect all inputs of the refinement clause and attempt -- 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); Ref_Input := First (Ref_Inputs);
while Present (Ref_Input) loop while Present (Ref_Input) loop
...@@ -20256,7 +20290,7 @@ package body Sem_Prag is ...@@ -20256,7 +20290,7 @@ package body Sem_Prag is
begin begin
-- The analysis of pragma Depends should produce normalized clauses -- The analysis of pragma Depends should produce normalized clauses
-- with exactly one output. This is important because output items -- 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. -- keys.
pragma Assert (No (Next (Dep_Output))); pragma Assert (No (Next (Dep_Output)));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment