+2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <quinot@adacore.com>
+
+ * sem_ch13.adb: Minor reformatting.
+ Remove redundant assertion.
+
2012-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
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
-- 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;
-- Build function declaration
- pragma Assert (Has_Predicates (Typ));
SId :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
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
--------------------------------------------
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;
-------------------------------------------
projects / platform / upstream / linaro-gcc.git / commitdiff