+2012-01-23 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.ads, sem_prag.adb: Minor reformatting.
+
+2012-01-23 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch13.adb (Analyze_Aspect_Specifications): Check for
+ language defined aspect applied to renaming or formal type
+ declaration (not permitted)
+
+2012-01-23 Matthew Heaney <heaney@adacore.com>
+
+ * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb (Vet): Replaced
+ comment with pragma Assert.
+
2012-01-23 Vincent Pucci <pucci@adacore.com>
* sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Call
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
New_Node : Count_Type);
function Vet (Position : Cursor) return Boolean;
+ -- Checks invariants of the cursor and its designated container, as a
+ -- simple way of detecting dangling references (see operation Free for a
+ -- description of the detection mechanism), returning True if all checks
+ -- pass. Invocations of Vet are used here as the argument of pragma Assert,
+ -- so the checks are performed only when assertions are enabled.
---------
-- "=" --
-- When an element is deleted from the list container, its node becomes
-- inactive, and so we set its Prev component to a negative value, to
-- indicate that it is now inactive. This provides a useful way to
- -- detect a dangling cursor reference.
+ -- detect a dangling cursor reference (and which is used in Vet).
N (X).Prev := -1; -- Node is deallocated (not on active list)
return False;
end if;
+ -- An invariant of an active node is that its Previous and Next
+ -- components are non-negative. Operation Free sets the Previous
+ -- component of the node to the value -1 before actually deallocating
+ -- the node, to mark the node as inactive. (By "dellocating" we mean
+ -- only that the node is linked onto a list of inactive nodes used
+ -- for storage.) This marker gives us a simple way to detect a
+ -- dangling reference to a node.
+
if N (Position.Node).Prev < 0 then -- see Free
return False;
end if;
return False;
end if;
- -- If we get here, we know that this disjunction is true:
- -- N (Position.Node).Prev /= 0 or else Position.Node = L.First
- -- Why not do this with an assertion???
+ pragma Assert (N (Position.Node).Prev /= 0
+ or else Position.Node = L.First);
if N (Position.Node).Next = 0
and then Position.Node /= L.Last
return False;
end if;
- -- If we get here, we know that this disjunction is true:
- -- N (Position.Node).Next /= 0 or else Position.Node = L.Last
- -- Why not do this with an assertion???
+ pragma Assert (N (Position.Node).Next /= 0
+ or else Position.Node = L.Last);
if L.Length = 1 then
return L.First = L.Last;
return False;
end if;
- -- Eliminate earlier disjunct
-
- if Position.Node = L.First then
+ if Position.Node = L.First then -- eliminates earlier disjunct
return True;
end if;
- -- If we get to this point, we know that this predicate is true:
- -- N (Position.Node).Prev /= 0
+ pragma Assert (N (Position.Node).Prev /= 0);
if Position.Node = L.Last then -- eliminates earlier disjunct
return True;
end if;
- -- If we get to this point, we know that this predicate is true:
- -- N (Position.Node).Next /= 0
+ pragma Assert (N (Position.Node).Next /= 0);
if N (N (Position.Node).Next).Prev /= Position.Node then
return False;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
New_Node : Node_Access);
function Vet (Position : Cursor) return Boolean;
+ -- Checks invariants of the cursor and its designated container, as a
+ -- simple way of detecting dangling references (see operation Free for a
+ -- description of the detection mechanism), returning True if all checks
+ -- pass. Invocations of Vet are used here as the argument of pragma Assert,
+ -- so the checks are performed only when assertions are enabled.
---------
-- "=" --
procedure Deallocate is
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
begin
+ -- While a node is in use, as an active link in a list, its Previous and
+ -- Next components must be null, or designate a different node; this is
+ -- a node invariant. Before actually deallocating the node, we set both
+ -- access value components of the node to point to the node itself, thus
+ -- falsifying the node invariant. Subprogram Vet inspects the value of
+ -- the node components when interrogating the node, in order to detect
+ -- whether the cursor's node access value is dangling.
+
+ -- Note that we have no guarantee that the storage for the node isn't
+ -- modified when it is deallocated, but there are other tests that Vet
+ -- does if node invariants appear to be satisifed. However, in practice
+ -- this simple test works well enough, detecting dangling references
+ -- immediately, without needing further interrogation.
+
X.Prev := X;
X.Next := X;
+
Deallocate (X);
end Free;
return False;
end if;
+ -- An invariant of a node is that its Previous and Next components can
+ -- be null, or designate a different node. Operation Free sets the
+ -- access value components of the node to designate the node itself
+ -- before actually deallocating the node, thus deliberately violating
+ -- the node invariant. This gives us a simple way to detect a dangling
+ -- reference to a node.
+
if Position.Node.Next = Position.Node then
return False;
end if;
return False;
end if;
+ -- In practice the tests above will detect most instances of a dangling
+ -- reference. If we get here, it means that the invariants of the
+ -- designated node are satisfied (they at least appear to be satisfied),
+ -- so we perform some more tests, to determine whether invariants of the
+ -- designated list are satisfied too.
+
declare
L : List renames Position.Container.all;
begin
return False;
end if;
- -- If we get here, we know that this disjunction is true:
- -- Position.Node.Prev /= null or else Position.Node = L.First
+ pragma Assert (Position.Node.Prev /= null
+ or else Position.Node = L.First);
if Position.Node.Next = null
and then Position.Node /= L.Last
return False;
end if;
- -- If we get here, we know that this disjunction is true:
- -- Position.Node.Next /= null or else Position.Node = L.Last
+ pragma Assert (Position.Node.Next /= null
+ or else Position.Node = L.Last);
if L.Length = 1 then
return L.First = L.Last;
return False;
end if;
- -- Eliminate earlier disjunct
-
- if Position.Node = L.First then
+ if Position.Node = L.First then -- eliminates earlier disjunct
return True;
end if;
- -- If we get here, we know (disjunctive syllogism) that this
- -- predicate is true: Position.Node.Prev /= null
-
- -- Eliminate earlier disjunct
+ pragma Assert (Position.Node.Prev /= null);
- if Position.Node = L.Last then
+ if Position.Node = L.Last then -- eliminates earlier disjunct
return True;
end if;
- -- If we get here, we know (disjunctive syllogism) that this
- -- predicate is true: Position.Node.Next /= null
+ pragma Assert (Position.Node.Next /= null);
if Position.Node.Next.Prev /= Position.Node then
return False;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
New_Node : Node_Access);
function Vet (Position : Cursor) return Boolean;
+ -- Checks invariants of the cursor and its designated container, as a
+ -- simple way of detecting dangling references (see operation Free for a
+ -- description of the detection mechanism), returning True if all checks
+ -- pass. Invocations of Vet are used here as the argument of pragma Assert,
+ -- so the checks are performed only when assertions are enabled.
---------
-- "=" --
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
begin
+ -- While a node is in use, as an active link in a list, its Previous and
+ -- Next components must be null, or designate a different node; this is
+ -- a node invariant. For this indefinite list, there is an additional
+ -- invariant: that the element access value be non-null. Before actually
+ -- deallocating the node, we set the node access value components of the
+ -- node to point to the node itself, and set the element access value to
+ -- null (by deallocating the node's element), thus falsifying the node
+ -- invariant. Subprogram Vet inspects the value of the node components
+ -- when interrogating the node, in order to detect whether the cursor's
+ -- node access value is dangling.
+
+ -- Note that we have no guarantee that the storage for the node isn't
+ -- modified when it is deallocated, but there are other tests that Vet
+ -- does if node invariants appear to be satisifed. However, in practice
+ -- this simple test works well enough, detecting dangling references
+ -- immediately, without needing further interrogation.
+
X.Next := X;
X.Prev := X;
return False;
end if;
+ -- An invariant of a node is that its Previous and Next components can
+ -- be null, or designate a different node. Also, its element access
+ -- value must be non-null. Operation Free sets the node access value
+ -- components of the node to designate the node itself, and the element
+ -- access value to null, before actually deallocating the node, thus
+ -- deliberately violating the node invariant. This gives us a simple way
+ -- to detect a dangling reference to a node.
+
if Position.Node.Next = Position.Node then
return False;
end if;
return False;
end if;
+ -- In practice the tests above will detect most instances of a dangling
+ -- reference. If we get here, it means that the invariants of the
+ -- designated node are satisfied (they at least appear to be satisfied),
+ -- so we perform some more tests, to determine whether invariants of the
+ -- designated list are satisfied too.
+
declare
L : List renames Position.Container.all;
begin
end loop;
end if;
+ -- Check some general restrictions on language defined aspects
+
+ if not Impl_Defined_Aspects (A_Id) then
+ Error_Msg_Name_1 := Nam;
+
+ -- Not allowed for renaming declarations
+
+ if Nkind (N) in N_Renaming_Declaration then
+ Error_Msg_N
+ ("aspect % not allowed for renaming declaration",
+ Aspect);
+ end if;
+
+ -- Not allowed for formal type declarations
+
+ if Nkind (N) = N_Formal_Type_Declaration then
+ Error_Msg_N
+ ("aspect % not allowed for formal type declaration",
+ Aspect);
+ end if;
+ end if;
+
-- Copy expression for later processing by the procedures
-- Check_Aspect_At_[Freeze_Point | End_Of_Declarations]
-- Make_Aspect_For_PPC_In_Gen_Sub_Decl --
-----------------------------------------
- -- Convert any PPC and pragmas that appear within a generic subprogram
- -- declaration into aspect.
-
procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id) is
- Aspects : constant List_Id := New_List;
- Loc : constant Source_Ptr := Sloc (Decl);
- Or_Decl : constant Node_Id := Original_Node (Decl);
- Aspect : Node_Id;
+ Aspects : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Decl);
+ Or_Decl : constant Node_Id := Original_Node (Decl);
+ Aspect : Node_Id;
+
Original_Aspects : List_Id;
-- To capture global references, a copy of the created aspects must be
-- inserted in the original tree.
- Prag : Node_Id;
- Prag_Arg_Ass : Node_Id;
- Prag_Id : Pragma_Id;
+ Prag : Node_Id;
+ Prag_Arg_Ass : Node_Id;
+ Prag_Id : Pragma_Id;
begin
- Prag := Next (Decl);
-
-- Check for any PPC pragmas that appear within Decl
+ Prag := Next (Decl);
while Nkind (Prag) = N_Pragma loop
Prag_Id := Get_Pragma_Id (Chars (Pragma_Identifier (Prag)));
-- Set all new aspects into the generic declaration node
if Is_Non_Empty_List (Aspects) then
- -- Create the list of aspects which will be inserted in the original
- -- tree.
+
+ -- Create the list of aspects to be inserted in the original tree
Original_Aspects := Copy_Separate_List (Aspects);
-- Check if Decl already has aspects
+
-- Attach the new lists of aspects to both the generic copy and the
-- original tree.
if Has_Aspects (Decl) then
Append_List (Aspects, Aspect_Specifications (Decl));
Append_List (Original_Aspects, Aspect_Specifications (Or_Decl));
+
else
Set_Parent (Aspects, Decl);
Set_Aspect_Specifications (Decl, Aspects);
-- In ASIS mode, for a pragma generated from a source aspect, also
-- analyze the original aspect expression.
- if ASIS_Mode
- and then Present (Corresponding_Aspect (N))
- then
+ if ASIS_Mode and then Present (Corresponding_Aspect (N)) then
Preanalyze_Spec_Expression
(Original_Node (Get_Pragma_Arg (Arg_Req)), Standard_Boolean);
end if;
-- In ASIS mode, for a pragma generated from a source aspect, also
-- analyze the original aspect expression.
- if ASIS_Mode
- and then Present (Corresponding_Aspect (N))
- then
+ if ASIS_Mode and then Present (Corresponding_Aspect (N)) then
Preanalyze_Spec_Expression
(Original_Node (Get_Pragma_Arg (Arg_Ens)), Standard_Boolean);
end if;
procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id);
-- This routine makes aspects from precondition or postcondition pragmas
-- that appear within a generic subprogram declaration. Decl is the generic
- -- subprogram declaration node.
- -- Note that the aspects are attached to the generic copy and also to the
- -- orginal tree.
+ -- subprogram declaration node. Note that the aspects are attached to the
+ -- generic copy and also to the orginal tree.
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with any
projects / gcc.git / commitdiff