Skip to content

R
riscv-gcc-1
Commit dd91386d by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r183423
parent f6834394
Showing with 155 additions and 54 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/a-cbdlli.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -81,6 +81,11 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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.
---------
-- "=" --
......@@ -682,7 +687,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- 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)
......@@ -2184,6 +2189,14 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......@@ -2206,9 +2219,8 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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
......@@ -2216,9 +2228,8 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......@@ -2264,21 +2275,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......
gcc/ada/a-cdlili.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -65,6 +65,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
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.
---------
-- "=" --
......@@ -528,8 +533,23 @@ package body Ada.Containers.Doubly_Linked_Lists is
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;
......@@ -1966,6 +1986,13 @@ package body Ada.Containers.Doubly_Linked_Lists is
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;
......@@ -1974,6 +2001,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
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
......@@ -2003,8 +2036,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
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
......@@ -2012,8 +2045,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
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;
......@@ -2059,23 +2092,17 @@ package body Ada.Containers.Doubly_Linked_Lists is
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;
......
gcc/ada/a-cidlli.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -68,6 +68,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
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.
---------
-- "=" --
......@@ -570,6 +575,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists 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. 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;
......@@ -2048,6 +2070,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
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;
......@@ -2060,6 +2090,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
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
......
gcc/ada/sem_ch13.adb
......@@ -890,6 +890,28 @@ package body Sem_Ch13 is
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]
......
gcc/ada/sem_prag.adb
......@@ -15247,27 +15247,24 @@ package body Sem_Prag is
-- 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)));
......@@ -15298,18 +15295,20 @@ package body Sem_Prag is
-- 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);
......@@ -15335,9 +15334,7 @@ package body Sem_Prag is
-- 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;
......@@ -15350,9 +15347,7 @@ package body Sem_Prag is
-- 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;
......
gcc/ada/sem_prag.ads
......@@ -113,9 +113,8 @@ package Sem_Prag is
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
......
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