Commit a6abfd78 by Arnaud Charlet

[multiple changes]

2014-02-25  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb, sem_ch6.adb, par-ch3.adb: Minor reformatting.

2014-02-25  Bob Duff  <duff@adacore.com>

	* s-tassta.adb (Finalize_Global_Tasks): Limit the number of loop
	iterations while waiting for independent tasks to terminate;
	if an independent task does not terminate, we do not want to
	hang here. In that case, the thread will be terminated when the
	process exits.
	* s-taprop-linux.adb (Abort_Task): Fix Assert to allow for ESRCH.

2014-02-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Check_SPARK_Aspect_For_ASIS): New subprogram,
	used to perform pre-analysis of the expression for SPARK
	aspects that have a non-standard syntax, such as GLobal and
	Initializes. The procedure applies to the original expression
	in an aspect specification, prior to the analysis of the
	corresponding pragma, in order to provide semantic information
	for ASIS navigation purposes.
	(Analyze_Global_In_Decl_List, Analyze_Initializes_In_Decl_Part):
	Call new subprogram.

From-SVN: r208127
parent 64e86d00
2014-02-25 Robert Dewar <dewar@adacore.com>
* sem_attr.adb, sem_ch6.adb, par-ch3.adb: Minor reformatting.
2014-02-25 Bob Duff <duff@adacore.com>
* s-tassta.adb (Finalize_Global_Tasks): Limit the number of loop
iterations while waiting for independent tasks to terminate;
if an independent task does not terminate, we do not want to
hang here. In that case, the thread will be terminated when the
process exits.
* s-taprop-linux.adb (Abort_Task): Fix Assert to allow for ESRCH.
2014-02-25 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Check_SPARK_Aspect_For_ASIS): New subprogram,
used to perform pre-analysis of the expression for SPARK
aspects that have a non-standard syntax, such as GLobal and
Initializes. The procedure applies to the original expression
in an aspect specification, prior to the analysis of the
corresponding pragma, in order to provide semantic information
for ASIS navigation purposes.
(Analyze_Global_In_Decl_List, Analyze_Initializes_In_Decl_Part):
Call new subprogram.
2014-02-25 Yannick Moy <moy@adacore.com> 2014-02-25 Yannick Moy <moy@adacore.com>
* sem_prag.adb: Remove obsolete reference to SPARK RM in error message. * sem_prag.adb: Remove obsolete reference to SPARK RM in error message.
......
...@@ -4620,8 +4620,8 @@ package body Ch3 is ...@@ -4620,8 +4620,8 @@ package body Ch3 is
-- Test for body scanned, not acceptable as basic decl item -- Test for body scanned, not acceptable as basic decl item
if Kind = N_Subprogram_Body or else if Kind = N_Subprogram_Body or else
Kind = N_Package_Body or else Kind = N_Package_Body or else
Kind = N_Task_Body or else Kind = N_Task_Body or else
Kind = N_Protected_Body Kind = N_Protected_Body
then then
Error_Msg ("proper body not allowed in package spec", Sloc (Decl)); Error_Msg ("proper body not allowed in package spec", Sloc (Decl));
...@@ -4629,9 +4629,8 @@ package body Ch3 is ...@@ -4629,9 +4629,8 @@ package body Ch3 is
-- Complete declaration of mangled subprogram body, for better -- Complete declaration of mangled subprogram body, for better
-- recovery if analysis is attempted. -- recovery if analysis is attempted.
if Nkind_In if Nkind_In (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body)
(Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body) and then No (Handled_Statement_Sequence (Decl))
and then No (Handled_Statement_Sequence (Decl))
then then
Set_Handled_Statement_Sequence (Decl, Set_Handled_Statement_Sequence (Decl,
Make_Handled_Sequence_Of_Statements (Sloc (Decl), Make_Handled_Sequence_Of_Statements (Sloc (Decl),
......
...@@ -1078,13 +1078,16 @@ package body System.Task_Primitives.Operations is ...@@ -1078,13 +1078,16 @@ package body System.Task_Primitives.Operations is
procedure Abort_Task (T : Task_Id) is procedure Abort_Task (T : Task_Id) is
Result : Interfaces.C.int; Result : Interfaces.C.int;
ESRCH : constant := 3; -- No such process
-- It can happen that T has already vanished, in which case pthread_kill
-- returns ESRCH, so we don't consider that to be an error.
begin begin
if Abort_Handler_Installed then if Abort_Handler_Installed then
Result := Result :=
pthread_kill pthread_kill
(T.Common.LL.Thread, (T.Common.LL.Thread,
Signal (System.Interrupt_Management.Abort_Task_Interrupt)); Signal (System.Interrupt_Management.Abort_Task_Interrupt));
pragma Assert (Result = 0); pragma Assert (Result = 0 or else Result = ESRCH);
end if; end if;
end Abort_Task; end Abort_Task;
......
...@@ -869,15 +869,18 @@ package body System.Tasking.Stages is ...@@ -869,15 +869,18 @@ package body System.Tasking.Stages is
Write_Lock (Self_ID); Write_Lock (Self_ID);
-- If the Abort_Task signal is set to system, it means that we may not -- If the Abort_Task signal is set to system, it means that we may
-- have been able to abort all independent tasks (in particular -- not have been able to abort all independent tasks (in particular
-- Server_Task may be blocked, waiting for a signal), in which case, -- Server_Task may be blocked, waiting for a signal), in which case, do
-- do not wait for Independent_Task_Count to go down to 0. -- not wait for Independent_Task_Count to go down to 0. We arbitrarily
-- limit the number of loop iterations; if an independent task does not
if State -- terminate, we do not want to hang here. In that case, the thread will
(System.Interrupt_Management.Abort_Task_Interrupt) /= Default -- be terminated when the process exits.
if State (System.Interrupt_Management.Abort_Task_Interrupt) /=
Default
then then
loop for J in 1 .. 10 loop
exit when Utilities.Independent_Task_Count = 0; exit when Utilities.Independent_Task_Count = 0;
-- We used to yield here, but this did not take into account low -- We used to yield here, but this did not take into account low
......
...@@ -6259,6 +6259,7 @@ package body Sem_Attr is ...@@ -6259,6 +6259,7 @@ package body Sem_Attr is
-- dimensional array. -- dimensional array.
Index_Type := First_Index (P_Type); Index_Type := First_Index (P_Type);
if Present (Next_Index (Index_Type)) then if Present (Next_Index (Index_Type)) then
Error_Msg_N Error_Msg_N
("too few subscripts in array reference", Comp); ("too few subscripts in array reference", Comp);
......
...@@ -309,17 +309,18 @@ package body Sem_Ch6 is ...@@ -309,17 +309,18 @@ package body Sem_Ch6 is
if Present (Parameter_Specifications (New_Spec)) then if Present (Parameter_Specifications (New_Spec)) then
declare declare
Formal_Spec : Node_Id; Formal_Spec : Node_Id;
Def : Entity_Id;
begin begin
Formal_Spec := First (Parameter_Specifications (New_Spec)); Formal_Spec := First (Parameter_Specifications (New_Spec));
-- Create a new formal parameter at the same source position -- Create a new formal parameter at the same source position
while Present (Formal_Spec) loop while Present (Formal_Spec) loop
Set_Defining_Identifier Def := Defining_Identifier (Formal_Spec);
(Formal_Spec, Set_Defining_Identifier (Formal_Spec,
Make_Defining_Identifier Make_Defining_Identifier (Sloc (Def),
(Sloc (Defining_Identifier (Formal_Spec)), Chars => Chars (Def)));
Chars => Chars (Defining_Identifier (Formal_Spec))));
Next (Formal_Spec); Next (Formal_Spec);
end loop; end loop;
end; end;
......
...@@ -216,6 +216,12 @@ package body Sem_Prag is ...@@ -216,6 +216,12 @@ package body Sem_Prag is
-- _Post, _Invariant, or _Type_Invariant, which are special names used -- _Post, _Invariant, or _Type_Invariant, which are special names used
-- in identifiers to represent these attribute references. -- in identifiers to represent these attribute references.
procedure Check_SPARK_Aspect_For_ASIS (N : Node_Id);
-- In ASIS mode we need to analyze the original expression in the aspect
-- specification. For Initializes, Global, and related SPARK aspects, the
-- expression has a sui-generis syntax which may be a list, an expression,
-- or an aggregate.
procedure Check_State_And_Constituent_Use procedure Check_State_And_Constituent_Use
(States : Elist_Id; (States : Elist_Id;
Constits : Elist_Id; Constits : Elist_Id;
...@@ -2329,6 +2335,7 @@ package body Sem_Prag is ...@@ -2329,6 +2335,7 @@ package body Sem_Prag is
begin begin
Set_Analyzed (N); Set_Analyzed (N);
Check_SPARK_Aspect_For_ASIS (N);
-- Verify the syntax of pragma Global when SPARK checks are suppressed. -- Verify the syntax of pragma Global when SPARK checks are suppressed.
-- Semantic analysis is disabled in this mode. -- Semantic analysis is disabled in this mode.
...@@ -2798,6 +2805,8 @@ package body Sem_Prag is ...@@ -2798,6 +2805,8 @@ package body Sem_Prag is
begin begin
Set_Analyzed (N); Set_Analyzed (N);
Check_SPARK_Aspect_For_ASIS (N);
-- Nothing to do when the initialization list is empty -- Nothing to do when the initialization list is empty
if Nkind (Inits) = N_Null then if Nkind (Inits) = N_Null then
...@@ -24668,6 +24677,43 @@ package body Sem_Prag is ...@@ -24668,6 +24677,43 @@ package body Sem_Prag is
end if; end if;
end Check_Missing_Part_Of; end Check_Missing_Part_Of;
---------------------------------
-- Check_SPARK_Aspect_For_ASIS --
---------------------------------
procedure Check_SPARK_Aspect_For_ASIS (N : Node_Id) is
Expr : Node_Id;
begin
if ASIS_Mode and then From_Aspect_Specification (N) then
Expr := Expression (Corresponding_Aspect (N));
if Nkind (Expr) /= N_Aggregate then
Preanalyze_And_Resolve (Expr);
else
declare
Comps : constant List_Id := Component_Associations (Expr);
Exprs : constant List_Id := Expressions (Expr);
C : Node_Id;
E : Node_Id;
begin
E := First (Exprs);
while Present (E) loop
Analyze (E);
Next (E);
end loop;
C := First (Comps);
while Present (C) loop
Analyze (Expression (C));
Next (C);
end loop;
end;
end if;
end if;
end Check_SPARK_Aspect_For_ASIS;
------------------------------------- -------------------------------------
-- Check_State_And_Constituent_Use -- -- Check_State_And_Constituent_Use --
------------------------------------- -------------------------------------
......
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