From: Arnaud Charlet Date: Wed, 5 Dec 2012 11:17:09 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5e0c742b7a22f7f26295b10de3a5392bf200d539;p=gcc.git [multiple changes] 2012-12-05 Hristian Kirtchev * sem_prag.adb (Check_Loop_Invariant_Variant_Placement): When pragma Loop_[In]variant does not appear immediately within the statements of a loop, it must appear in a chain of nested blocks. 2012-12-05 Thomas Quinot * sem_ch13.adb: Minor reformatting. Remove redundant assertion. From-SVN: r194213 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c323d7cf4aa..89030d9d584 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2012-12-05 Hristian Kirtchev + + * sem_prag.adb (Check_Loop_Invariant_Variant_Placement): When pragma + Loop_[In]variant does not appear immediately within the statements + of a loop, it must appear in a chain of nested blocks. + +2012-12-05 Thomas Quinot + + * sem_ch13.adb: Minor reformatting. + Remove redundant assertion. + 2012-12-05 Thomas Quinot * par_sco.adb, scos.ads, put_scos.adb, put_scos.ads, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8bdf27ff18a..887b0792e78 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -84,7 +84,7 @@ package body Sem_Ch13 is procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ, - -- then either there are pragma Invariant entries on the rep chain for the + -- then either there are pragma Predicate entries on the rep chain for the -- type (note that Predicate aspects are converted to pragma Predicate), or -- there are inherited aspects from a parent type, or ancestor subtypes. -- This procedure builds the spec and body for the Predicate function that @@ -5423,9 +5423,9 @@ package body Sem_Ch13 is -- use this function even if checks are off, e.g. for membership tests. procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is - Loc : constant Source_Ptr := Sloc (Typ); - Spec : Node_Id; - SId : Entity_Id; + Loc : constant Source_Ptr := Sloc (Typ); + Spec : Node_Id; + SId : Entity_Id; FDecl : Node_Id; FBody : Node_Id; @@ -5669,7 +5669,6 @@ package body Sem_Ch13 is -- Build function declaration - pragma Assert (Has_Predicates (Typ)); SId := Make_Defining_Identifier (Loc, Chars => New_External_Name (Chars (Typ), "Predicate")); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index ddd84822ce1..be5afe028a6 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -620,7 +620,7 @@ package body Sem_Prag is procedure Check_Loop_Invariant_Variant_Placement; -- Verify whether pragma Loop_Invariant or pragma Loop_Variant appear - -- immediately within the statements of the related loop. + -- immediately within a construct restricted to loops. procedure Check_Is_In_Decl_Part_Or_Package_Spec; -- Check that pragma appears in a declarative part, or in a package @@ -1921,37 +1921,89 @@ package body Sem_Prag is -------------------------------------------- procedure Check_Loop_Invariant_Variant_Placement is - Loop_Stmt : Node_Id; + procedure Placement_Error (Constr : Node_Id); + -- Node Constr denotes the last loop restricted construct before we + -- encountered an illegal relation between enclosing constructs. Emit + -- an error depending on what Constr was. + + --------------------- + -- Placement_Error -- + --------------------- + + procedure Placement_Error (Constr : Node_Id) is + begin + if Nkind (Constr) = N_Pragma then + Error_Pragma + ("pragma % must appear immediately within the statements " & + "of a loop"); + else + Error_Pragma_Arg + ("block containing pragma % must appear immediately within " & + "the statements of a loop", Constr); + end if; + end Placement_Error; + + -- Local declarations + + Prev : Node_Id; + Stmt : Node_Id; + + -- Start of processing for Check_Loop_Invariant_Variant_Placement begin - -- Locate the enclosing loop statement (if any) + Prev := N; + Stmt := Parent (N); + while Present (Stmt) loop - Loop_Stmt := N; - while Present (Loop_Stmt) loop - if Nkind (Loop_Stmt) = N_Loop_Statement then - exit; + -- The pragma or previous block must appear immediately within the + -- current block's declarative or statement part. + + if Nkind (Stmt) = N_Block_Statement then + if (No (Declarations (Stmt)) + or else List_Containing (Prev) /= Declarations (Stmt)) + and then + List_Containing (Prev) /= + Statements (Handled_Statement_Sequence (Stmt)) + then + Placement_Error (Prev); + return; - -- Prevent the search from going too far + -- Keep inspecting the parents because we are now within a + -- chain of nested blocks. + + else + Prev := Stmt; + Stmt := Parent (Stmt); + end if; + + -- The pragma or previous block must appear immediately within the + -- statements of the loop. + + elsif Nkind (Stmt) = N_Loop_Statement then + if List_Containing (Prev) /= Statements (Stmt) then + Placement_Error (Prev); + end if; + + -- Stop the traversal because we reached the innermost loop + -- regardless of whether we encountered an error or not. - elsif Nkind_In (Loop_Stmt, N_Entry_Body, - N_Package_Body, - N_Package_Declaration, - N_Protected_Body, - N_Subprogram_Body, - N_Task_Body) - then - Error_Pragma ("pragma % must appear inside a loop statement"); return; + -- Ignore a handled statement sequence. Note that this node may + -- be related to a subprogram body in which case we will emit an + -- error on the next iteration of the search. + + elsif Nkind (Stmt) = N_Handled_Sequence_Of_Statements then + Stmt := Parent (Stmt); + + -- Any other statement breaks the chain from the pragma to the + -- loop. + else - Loop_Stmt := Parent (Loop_Stmt); + Placement_Error (Prev); + return; end if; end loop; - - if List_Containing (N) /= Statements (Loop_Stmt) then - Error_Pragma - ("pragma % must occur immediately in the statements of a loop"); - end if; end Check_Loop_Invariant_Variant_Placement; -------------------------------------------