diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 25 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-linux.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 46 |
7 files changed, 97 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6850ef5..a3df028 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +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> * sem_prag.adb: Remove obsolete reference to SPARK RM in error message. diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index de50e02..e9524fa 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4620,8 +4620,8 @@ package body Ch3 is -- Test for body scanned, not acceptable as basic decl item if Kind = N_Subprogram_Body or else - Kind = N_Package_Body or else - Kind = N_Task_Body or else + Kind = N_Package_Body or else + Kind = N_Task_Body or else Kind = N_Protected_Body then Error_Msg ("proper body not allowed in package spec", Sloc (Decl)); @@ -4629,9 +4629,8 @@ package body Ch3 is -- Complete declaration of mangled subprogram body, for better -- recovery if analysis is attempted. - if Nkind_In - (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body) - and then No (Handled_Statement_Sequence (Decl)) + if Nkind_In (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body) + and then No (Handled_Statement_Sequence (Decl)) then Set_Handled_Statement_Sequence (Decl, Make_Handled_Sequence_Of_Statements (Sloc (Decl), diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index b8accbec..515850a 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -1078,13 +1078,16 @@ package body System.Task_Primitives.Operations is procedure Abort_Task (T : Task_Id) is 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 if Abort_Handler_Installed then Result := pthread_kill (T.Common.LL.Thread, Signal (System.Interrupt_Management.Abort_Task_Interrupt)); - pragma Assert (Result = 0); + pragma Assert (Result = 0 or else Result = ESRCH); end if; end Abort_Task; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 58e8f98..4eff8ee 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -869,15 +869,18 @@ package body System.Tasking.Stages is Write_Lock (Self_ID); - -- If the Abort_Task signal is set to system, it means that we may not - -- have been able to abort all independent tasks (in particular - -- Server_Task may be blocked, waiting for a signal), in which case, - -- do not wait for Independent_Task_Count to go down to 0. - - if State - (System.Interrupt_Management.Abort_Task_Interrupt) /= Default + -- If the Abort_Task signal is set to system, it means that we may + -- not have been able to abort all independent tasks (in particular + -- Server_Task may be blocked, waiting for a signal), in which case, do + -- 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 + -- terminate, we do not want to hang here. In that case, the thread will + -- be terminated when the process exits. + + if State (System.Interrupt_Management.Abort_Task_Interrupt) /= + Default then - loop + for J in 1 .. 10 loop exit when Utilities.Independent_Task_Count = 0; -- We used to yield here, but this did not take into account low diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 38c7e07..f6e63aa 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6259,6 +6259,7 @@ package body Sem_Attr is -- dimensional array. Index_Type := First_Index (P_Type); + if Present (Next_Index (Index_Type)) then Error_Msg_N ("too few subscripts in array reference", Comp); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2bfb8bb..6755048 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -309,17 +309,18 @@ package body Sem_Ch6 is if Present (Parameter_Specifications (New_Spec)) then declare Formal_Spec : Node_Id; + Def : Entity_Id; + begin Formal_Spec := First (Parameter_Specifications (New_Spec)); -- Create a new formal parameter at the same source position while Present (Formal_Spec) loop - Set_Defining_Identifier - (Formal_Spec, - Make_Defining_Identifier - (Sloc (Defining_Identifier (Formal_Spec)), - Chars => Chars (Defining_Identifier (Formal_Spec)))); + Def := Defining_Identifier (Formal_Spec); + Set_Defining_Identifier (Formal_Spec, + Make_Defining_Identifier (Sloc (Def), + Chars => Chars (Def))); Next (Formal_Spec); end loop; end; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bb5dafa..3747dfd 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -216,6 +216,12 @@ package body Sem_Prag is -- _Post, _Invariant, or _Type_Invariant, which are special names used -- 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 (States : Elist_Id; Constits : Elist_Id; @@ -2329,6 +2335,7 @@ package body Sem_Prag is begin Set_Analyzed (N); + Check_SPARK_Aspect_For_ASIS (N); -- Verify the syntax of pragma Global when SPARK checks are suppressed. -- Semantic analysis is disabled in this mode. @@ -2798,6 +2805,8 @@ package body Sem_Prag is begin Set_Analyzed (N); + Check_SPARK_Aspect_For_ASIS (N); + -- Nothing to do when the initialization list is empty if Nkind (Inits) = N_Null then @@ -24668,6 +24677,43 @@ package body Sem_Prag is end if; 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 -- ------------------------------------- |